helm/hxsp/splitted/3.daemon.p.pl

   1 #################################################################################################
   2 #################################################################################################
   3 # HTTP::Daemon Operations
   4 #################################################################################################
   5 #################################################################################################
   6
   7 # do not accumulate defunct processes
   8 $SIG{CHLD} = "IGNORE";
   9 $SIG{USR1} = \&listen; # sent by the child to make the parent read the pipe
  10
  11 pipe LIST_CHILD, TELL_PARENT;
  12 pipe LIST_PARENT, TELL_CHILD;
  13 TELL_PARENT->autoflush(1);
  14 TELL_CHILD->autoflush(1);
  15
  16
  17 sub listen {
  18    my $res;
  19    my $query = <LIST_CHILD>;
  20    if ($query =~ /^add /) {
  21       $query =~ s/^add //;
  22       chomp($query);
  23       $res = add($query);
  24    }
  25    elsif ($query =~ /^reload /) {
  26       $query =~ s/^reload //;
  27       chomp($query);
  28       $res = reload($query);
  29    }
  30    elsif ($query =~ /^remove /) {
  31       $query =~ s/^remove //;
  32       chomp($query);
  33       $res = remove($query);
  34    }
  35    print TELL_CHILD "$res\n";
  36    print TELL_CHILD "____\n"; # end of response
  37 }
  38
  39 while (my $c = $d->accept) #connect
  40 {
  41    if (fork() == 0) #start new concurrent process
  42    {
  43       while (my $r = $c->get_request) #get http request
  44       {
  45          if ($r->method eq 'GET' &&
  46          ($r->url->path eq $working_path or $r->url->path eq $working_path."/"))#start dir
  47          {
  48              my $response = new HTTP::Response;
  49              $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0');
  50              $response->content(home($r->url->query));
  51              $c->send_response($response);
  52          }
  53          elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/help")#usage
  54          {
  55              my $response = new HTTP::Response;
  56              $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0');
  57              $response->content(help($r->url->query));
  58              $c->send_response($response);
  59          }
  60          elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/add")#add
  61          {
  62              my $response = new HTTP::Response;
  63              kill(USR1,getppid()); # ask the parent to read the pipe
  64              my $qs = $r->url->query;
  65              print TELL_PARENT "add $qs\n";
  66              my $in;
  67              while (($in = <LIST_PARENT>) ne "____\n") {
  68                 $res .= $in;
  69              }
  70              chomp($res);
  71              $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0');
  72              $response->content($res);
  73              $c->send_response($response);
  74          }
  75          elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/remove")#remove
  76          {
  77              my $response = new HTTP::Response;
  78              kill(USR1,getppid()); # ask the parent to read the pipe
  79              my $qs = $r->url->query;
  80              print TELL_PARENT "remove $qs\n";
  81              my $in;
  82              my $res="";
  83              while (($in = <LIST_PARENT>) ne "____\n") {
  84                  $res .= $in;
  85              }
  86              chomp($res);
  87              $response->content($res);
  88              $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0');
  89              $c->send_response($response);
  90          }
  91          elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/reload")#reload
  92          {
  93              my $response = new HTTP::Response;
  94              kill(USR1,getppid()); # ask the parent to read the pipe
  95              my $qs = $r->url->query;
  96              print TELL_PARENT "reload $qs\n";
  97              my $in;
  98              my $res="";
  99              while (($in = <LIST_PARENT>) ne "____\n") {
 100                  $res .= $in;
 101              }
 102              chomp($res);
 103              $response->content($res);
 104              $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0');
 105              $c->send_response($response);
 106          }
 107          elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/list")#list
 108          {
 109              my $response = new HTTP::Response;
 110              $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0');
 111              $response->content(list($r->url->query));
 112              $c->send_response($response);
 113          }
 114          elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/apply")#apply
 115          {
 116              my %headers;
 117              my $response = new HTTP::Response;
 118              $response->content(apply($r->url->query,\%headers));
 119              $response->header(%headers);
 120              $c->send_response($response);
 121          }
 122          else #wrong command or not working_path
 123          {
 124              $c->send_error(RC_FORBIDDEN)
 125          }
 126       }
 127       $c->close;
 128       undef($c);
 129       exit;
 130    } # fork
 131 }