First version of hxsp (new version of UWOBO implemented in Perl by

[helm.git] / helm / hxsp / splitted / 3.daemon.p.pl

diff --git a/helm/hxsp/splitted/3.daemon.p.pl b/helm/hxsp/splitted/3.daemon.p.pl
new file mode 100644 (file)
index 0000000..3e37873
--- /dev/null
+++ b/helm/hxsp/splitted/3.daemon.p.pl
@@ -0,0 +1,131 @@
+#################################################################################################
+#################################################################################################
+# HTTP::Daemon Operations
+#################################################################################################
+#################################################################################################
+
+# do not accumulate defunct processes
+$SIG{CHLD} = "IGNORE";
+$SIG{USR1} = \&listen; # sent by the child to make the parent read the pipe
+
+pipe LIST_CHILD, TELL_PARENT;
+pipe LIST_PARENT, TELL_CHILD;
+TELL_PARENT->autoflush(1);
+TELL_CHILD->autoflush(1);
+
+
+sub listen {
+   my $res;
+   my $query = <LIST_CHILD>;
+   if ($query =~ /^add /) {
+      $query =~ s/^add //;
+      chomp($query);
+      $res = add($query);
+   }
+   elsif ($query =~ /^reload /) {
+      $query =~ s/^reload //;
+      chomp($query);
+      $res = reload($query);
+   }
+   elsif ($query =~ /^remove /) {
+      $query =~ s/^remove //;
+      chomp($query);
+      $res = remove($query);
+   }
+   print TELL_CHILD "$res\n";
+   print TELL_CHILD "____\n"; # end of response
+}
+
+while (my $c = $d->accept) #connect
+{
+   if (fork() == 0) #start new concurrent process
+   {
+      while (my $r = $c->get_request) #get http request
+      {
+         if ($r->method eq 'GET' &&
+         ($r->url->path eq $working_path or $r->url->path eq $working_path."/"))#start dir
+         {
+             my $response = new HTTP::Response;
+             $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0');
+             $response->content(home($r->url->query));
+             $c->send_response($response);
+         }
+         elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/help")#usage
+         {
+             my $response = new HTTP::Response;
+             $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0');
+             $response->content(help($r->url->query));
+             $c->send_response($response);
+         }
+         elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/add")#add
+         {
+             my $response = new HTTP::Response;
+             kill(USR1,getppid()); # ask the parent to read the pipe
+             my $qs = $r->url->query;
+             print TELL_PARENT "add $qs\n";
+             my $in;
+             while (($in = <LIST_PARENT>) ne "____\n") {
+                $res .= $in;
+             }
+             chomp($res);
+             $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0');
+             $response->content($res);
+             $c->send_response($response);
+         }
+         elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/remove")#remove
+         {
+             my $response = new HTTP::Response;
+             kill(USR1,getppid()); # ask the parent to read the pipe
+             my $qs = $r->url->query;
+             print TELL_PARENT "remove $qs\n";
+             my $in;
+             my $res="";
+             while (($in = <LIST_PARENT>) ne "____\n") {
+                 $res .= $in;
+             }
+             chomp($res);
+             $response->content($res);
+             $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0');
+             $c->send_response($response);
+         }
+         elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/reload")#reload
+         {
+             my $response = new HTTP::Response;
+             kill(USR1,getppid()); # ask the parent to read the pipe
+             my $qs = $r->url->query;
+             print TELL_PARENT "reload $qs\n";
+             my $in;
+             my $res="";
+             while (($in = <LIST_PARENT>) ne "____\n") {
+                 $res .= $in;
+             }
+             chomp($res);
+             $response->content($res);
+             $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0');
+             $c->send_response($response);
+         }
+         elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/list")#list
+         {
+             my $response = new HTTP::Response;
+             $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0');
+             $response->content(list($r->url->query));
+             $c->send_response($response);
+         }
+         elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/apply")#apply
+         {
+             my %headers;
+             my $response = new HTTP::Response;
+             $response->content(apply($r->url->query,\%headers));
+             $response->header(%headers);
+             $c->send_response($response);
+         }
+         else #wrong command or not working_path
+         {
+             $c->send_error(RC_FORBIDDEN)
+         }
+      }
+      $c->close;
+      undef($c);
+      exit;
+   } # fork
+}