3 # First of all, let's load HELM configuration
5 my $HELM_CONFIGURATION_PREFIX = $ENV{"HELM_CONFIGURATION_PREFIX"};
6 my $HELM_CONFIGURATION_PATH =
7 $HELM_CONFIGURATION_PREFIX."/local/lib/helm/configuration.pl";
8 # next require defines: $helm_dir, $html_link
9 require $HELM_CONFIGURATION_PATH;
20 my $d = new HTTP::Daemon LocalPort => 8081;
21 tie(%map, 'DB_File', 'urls_of_uris.db', O_RDONLY, 0664);
22 print "Please contact me at: <URL:", $d->url, ">\n";
23 print "helm_dir: $helm_dir\n";
24 $SIG{CHLD} = "IGNORE"; # do not accumulate defunct processes
25 while (my $c = $d->accept) {
27 while (my $r = $c->get_request) {
28 #CSC: mancano i controlli di sicurezza
32 $cicuri =~ s/^[^?]*\?url=(.*)/$1/;
33 print "*".$r->url."\n";
34 my $http_method = $r->method;
35 my $http_path = $r->url->path;
36 if ($http_method eq 'GET' and $http_path eq "/get") {
37 my $filename = $cicuri;
38 $filename =~ s/cic:(.*)/$1/;
39 $filename =~ s/theory:(.*)/$1/;
40 $filename = $helm_dir.$filename.".xml";
41 my $resolved = $map{$cicuri};
42 print "$cicuri ==> $resolved ($filename)\n";
43 if (stat($filename)) {
44 print "Using local copy\n";
46 while(<FD>) { $cont .= $_; }
48 my $res = new HTTP::Response;
50 $c->send_response($res);
52 print "Downloading\n";
53 $ua = LWP::UserAgent->new;
54 $request = HTTP::Request->new(GET => "$resolved");
55 $response = $ua->request($request, \&callback);
57 print "Storing file\n";
59 open(FD, ">".$filename);
63 my $res = new HTTP::Response;
65 $c->send_response($res);
67 } elsif ($http_method eq 'GET' and $http_path eq "/annotate") {
68 my $do_annotate = ($cicuri =~ /\.ann$/);
69 my $target_to_annotate = $cicuri;
70 $target_to_annotate =~ s/(.*)\.ann$/$1/ if $do_annotate;
71 my $filename = $cicuri;
72 $filename =~ s/cic:(.*)/$1/;
73 $filename =~ s/theory:(.*)/$1/;
74 my $filename_target = $helm_dir.$filename if $do_annotate;
75 $filename = $helm_dir.$filename.".xml";
76 $filename_target =~ s/(.*)\.ann$/$1.xml/ if $do_annotate;
77 my $resolved = $map{$cicuri};
78 my $resolved_target = $map{$target_to_annotate} if $do_annotate;
80 print "($cicuri, $target_to_annotate) ==> ($resolved + $resolved_target) ($filename)\n";
82 print "$cicuri ==> $resolved ($filename)\n";
85 # Retrieves the annotation
87 if (stat($filename)) {
88 print "Using local copy for the annotation\n";
90 while(<FD>) { $cont .= $_; }
93 print "Downloading the annotation\n";
94 $ua = LWP::UserAgent->new;
95 $request = HTTP::Request->new(GET => "$resolved");
96 $response = $ua->request($request, \&callback);
98 print "Storing file for the annotation\n";
100 open(FD, ">".$filename);
104 my $annotation = $cont;
106 # Retrieves the target to annotate
110 if (stat($filename_target)) {
111 print "Using local copy for the file to annotate\n";
112 open(FD, $filename_target);
113 while(<FD>) { $cont .= $_; }
116 print "Downloading the file to annotate\n";
117 $ua = LWP::UserAgent->new;
118 $request = HTTP::Request->new(GET => "$resolved_target");
119 $response = $ua->request($request, \&callback);
121 print "Storing file for the file to annotate\n";
122 mkdirs($filename_target);
123 open(FD, ">".$filename_target);
130 # Merging the annotation and the target
132 $target =~ s/<\?xml [^?]*\?>//sg;
133 $target =~ s/<!DOCTYPE [^>]*>//sg;
134 $annotation =~ s/<\?xml [^?]*\?>//sg;
135 $annotation =~ s/<!DOCTYPE [^>]*>//sg;
137 <?xml version="1.0" encoding="UTF-8"?>
138 <cicxml uri="$target_to_annotate">
144 # Answering the client
146 my $res = new HTTP::Response;
147 $res->content($merged);
148 $c->send_response($res);
149 } elsif ($http_method eq 'GET' and $http_path eq "/getwithtypes") {
150 my $do_annotate = ($cicuri =~ /\.types$/);
151 my $target_to_annotate = $cicuri;
152 $target_to_annotate =~ s/(.*)\.types$/$1/ if $do_annotate;
153 my $filename = $cicuri;
154 $filename =~ s/cic:(.*)/$1/;
155 $filename =~ s/theory:(.*)/$1/;
156 my $filename_target = $helm_dir.$filename if $do_annotate;
157 $filename = $helm_dir.$filename.".xml";
158 $filename_target =~ s/(.*)\.types$/$1.xml/ if $do_annotate;
159 my $resolved = $map{$cicuri};
160 my $resolved_target = $map{$target_to_annotate} if $do_annotate;
162 print "GETWITHTYPES!!\n";
163 print "($cicuri, $target_to_annotate) ==> ($resolved + $resolved_target) ($filename)\n";
165 print "$cicuri ==> $resolved ($filename)\n";
168 # Retrieves the annotation
170 if (stat($filename)) {
171 print "Using local copy for the types\n";
173 while(<FD>) { $cont .= $_; }
176 print "Downloading the types\n";
177 $ua = LWP::UserAgent->new;
178 $request = HTTP::Request->new(GET => "$resolved");
179 $response = $ua->request($request, \&callback);
181 print "Storing file for the types\n";
183 open(FD, ">".$filename);
187 my $annotation = $cont;
189 # Retrieves the target to annotate
194 if (stat($filename_target)) {
195 print "Using local copy for the file to type\n";
196 open(FD, $filename_target);
197 while(<FD>) { $cont .= $_; }
200 print "Downloading the file to type\n";
201 $ua = LWP::UserAgent->new;
202 $request = HTTP::Request->new(GET => "$resolved_target");
203 $response = $ua->request($request, \&callback);
205 print "Storing file for the file to type\n";
206 mkdirs($filename_target);
207 open(FD, ">".$filename_target);
213 $target = $annotation;
217 # Merging the annotation and the target
219 $target =~ s/<\?xml [^?]*\?>//sg;
220 $target =~ s/<!DOCTYPE [^>]*>//sg;
221 $annotation =~ s/<\?xml [^?]*\?>//sg;
222 $annotation =~ s/<!DOCTYPE [^>]*>//sg;
224 <?xml version="1.0" encoding="UTF-8"?>
225 <cicxml uri="$target_to_annotate">
233 # Answering the client
235 my $res = new HTTP::Response;
236 $res->content($merged);
237 $c->send_response($res);
238 } elsif ($http_method eq 'GET' and $http_path eq "/getdtd") {
239 my $filename = $cicuri;
240 $filename = $helm_dir."/dtd/".$filename;
241 print "DTD: $cicuri ==> ($filename)\n";
242 if (stat($filename)) {
243 print "Using local copy\n";
245 while(<FD>) { $cont .= $_; }
247 my $res = new HTTP::Response;
248 $res->content($cont);
249 $c->send_response($res);
251 die "Could not find DTD!";
253 } elsif ($http_method eq 'GET' and $http_path eq "/conf") {
254 my $quoted_html_link = $html_link;
255 $quoted_html_link =~ s/&/&/g;
256 $quoted_html_link =~ s/</</g;
257 $quoted_html_link =~ s/>/>/g;
258 $quoted_html_link =~ s/'/'/g;
259 $quoted_html_link =~ s/"/"/g;
260 print "Configuration requested, returned #$quoted_html_link#\n";
261 $cont = "<?xml version=\"1.0\"?><html_link>$quoted_html_link</html_link>";
262 my $res = new HTTP::Response;
263 $res->content($cont);
264 $c->send_response($res);
266 print "INVALID REQUEST!!!!!\n";
267 $c->send_error(RC_FORBIDDEN)
272 print "\nCONNECTION CLOSED\n\n";
277 #================================
285 # Does not raise errors if could not create dirs/files
287 # Too much powerful: creates even /home, /home/users/, ...
291 my @dirs = split /\//,$pathname;
293 foreach $dir (@dirs) {
294 $tmp = ((defined($tmp)) ? $tmp = $tmp."\/".$dir : "");