]> matita.cs.unibo.it Git - helm.git/blob - helm/hxsp/splitted/3.daemon.p.pl
More notation.
[helm.git] / 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 }