+++ /dev/null
-#################################################################################################
-#################################################################################################
-# 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
-}