helm/http_getter/http_getter.pl

   1 #!/usr/bin/perl
   2
   3 # First of all, let's load HELM configuration
   4 use Env;
   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, $dtd_dir, $uris_dbm
   9 require $HELM_CONFIGURATION_PATH;
  10
  11
  12
  13 use HTTP::Daemon;
  14 use HTTP::Status;
  15 use HTTP::Request;
  16 use LWP::UserAgent;
  17 use DB_File;
  18
  19 my $cont = "";
  20 my $d = new HTTP::Daemon LocalPort => 8081;
  21 tie(%map, 'DB_File', $uris_dbm.".db", O_RDONLY, 0664);
  22 print "Please contact me at: <URL:", $d->url, ">\n";
  23 print "helm_dir: $helm_dir\n";
  24 print "dtd_dir: $dtd_dir\n";
  25 print "urls_of_uris.db: $uris_dbm.db\n";
  26 $SIG{CHLD} = "IGNORE"; # do not accumulate defunct processes
  27 while (my $c = $d->accept) {
  28  if (fork() == 0) {
  29     while (my $r = $c->get_request) {
  30         #CSC: mancano i controlli di sicurezza
  31
  32         $cont = "";
  33         my $cicuri = $r->url;
  34         $cicuri =~ s/^[^?]*\?url=(.*)/$1/;
  35         print "*".$r->url."\n";
  36         my $http_method = $r->method;
  37         my $http_path = $r->url->path;
  38         if ($http_method eq 'GET' and $http_path eq "/get") {
  39             my $filename = $cicuri;
  40             $filename =~ s/cic:(.*)/$1/;
  41             $filename =~ s/theory:(.*)/$1/;
  42             $filename = $helm_dir.$filename.".xml";
  43             my $resolved = $map{$cicuri};
  44             print "$cicuri ==> $resolved ($filename)\n";
  45             if (stat($filename)) {
  46                print "Using local copy\n";
  47                open(FD, $filename);
  48                while(<FD>) { $cont .= $_; }
  49                close(FD);
  50                my $res = new HTTP::Response;
  51                $res->content($cont);
  52                $c->send_response($res);
  53             } else {
  54                print "Downloading\n";
  55                $ua = LWP::UserAgent->new;
  56                $request = HTTP::Request->new(GET => "$resolved");
  57                $response = $ua->request($request, \&callback);
  58
  59                print "Storing file\n";
  60                mkdirs($filename);
  61                open(FD, ">".$filename);
  62                print FD $cont;
  63                close(FD);
  64
  65                my $res = new HTTP::Response;
  66                $res->content($cont);
  67                $c->send_response($res);
  68             }
  69         } elsif ($http_method eq 'GET' and $http_path eq "/annotate") {
  70             my $do_annotate = ($cicuri =~ /\.ann$/);
  71             my $target_to_annotate = $cicuri;
  72             $target_to_annotate =~ s/(.*)\.ann$/$1/ if $do_annotate;
  73             my $filename = $cicuri;
  74             $filename =~ s/cic:(.*)/$1/;
  75             $filename =~ s/theory:(.*)/$1/;
  76             my $filename_target = $helm_dir.$filename if $do_annotate;
  77             $filename = $helm_dir.$filename.".xml";
  78             $filename_target =~ s/(.*)\.ann$/$1.xml/ if $do_annotate;
  79             my $resolved = $map{$cicuri};
  80             my $resolved_target = $map{$target_to_annotate} if $do_annotate;
  81             if ($do_annotate) {
  82                print "($cicuri, $target_to_annotate) ==> ($resolved + $resolved_target) ($filename)\n";
  83             } else {
  84                print "$cicuri ==> $resolved ($filename)\n";
  85             }
  86
  87             # Retrieves the annotation
  88
  89             if (stat($filename)) {
  90                print "Using local copy for the annotation\n";
  91                open(FD, $filename);
  92                while(<FD>) { $cont .= $_; }
  93                close(FD);
  94             } else {
  95                print "Downloading the annotation\n";
  96                $ua = LWP::UserAgent->new;
  97                $request = HTTP::Request->new(GET => "$resolved");
  98                $response = $ua->request($request, \&callback);
  99
 100                print "Storing file for the annotation\n";
 101                mkdirs($filename);
 102                open(FD, ">".$filename);
 103                print FD $cont;
 104                close(FD);
 105             }
 106             my $annotation = $cont;
 107
 108             # Retrieves the target to annotate
 109
 110             $cont = "";
 111             if ($do_annotate) {
 112                if (stat($filename_target)) {
 113                   print "Using local copy for the file to annotate\n";
 114                   open(FD, $filename_target);
 115                   while(<FD>) { $cont .= $_; }
 116                   close(FD);
 117                } else {
 118                   print "Downloading the file to annotate\n";
 119                   $ua = LWP::UserAgent->new;
 120                   $request = HTTP::Request->new(GET => "$resolved_target");
 121                   $response = $ua->request($request, \&callback);
 122
 123                   print "Storing file for the file to annotate\n";
 124                   mkdirs($filename_target);
 125                   open(FD, ">".$filename_target);
 126                   print FD $cont;
 127                   close(FD);
 128                }
 129             }
 130             my $target = $cont;
 131
 132             # Merging the annotation and the target
 133
 134             $target =~ s/<\?xml [^?]*\?>//sg;
 135             $target =~ s/<!DOCTYPE [^>]*>//sg;
 136             $annotation =~ s/<\?xml [^?]*\?>//sg;
 137             $annotation =~ s/<!DOCTYPE [^>]*>//sg;
 138             my $merged = <<EOT;
 139 <?xml version="1.0" encoding="UTF-8"?>
 140 <cicxml uri="$target_to_annotate">
 141 $target
 142 $annotation
 143 </cicxml>
 144 EOT
 145
 146             # Answering the client
 147
 148             my $res = new HTTP::Response;
 149             $res->content($merged);
 150             $c->send_response($res);
 151         } elsif ($http_method eq 'GET' and $http_path eq "/getwithtypes") {
 152             my $mode;
 153             my $do_annotate;
 154             if ($cicuri =~ /\.types$/) {
 155                $do_annotate = 1;
 156                $mode = "types";
 157             } elsif ($cicuri =~ /\.ann$/) {
 158                $do_annotate = 1;
 159                $mode = "ann";
 160             } else {
 161                $do_annotate = 0;
 162             }
 163             my $target_to_annotate = $cicuri;
 164             if ($mode eq "types") {
 165                $target_to_annotate =~ s/(.*)\.types$/$1/;
 166             } elsif ($mode eq "ann") {
 167                $target_to_annotate =~ s/(.*)\.ann$/$1/;
 168             }
 169             my $filename = $cicuri;
 170             $filename =~ s/cic:(.*)/$1/;
 171             $filename =~ s/theory:(.*)/$1/;
 172             my $filename_target = $helm_dir.$filename if $do_annotate;
 173             $filename = $helm_dir.$filename.".xml";
 174             if ($mode eq "types") {
 175                $filename_target =~ s/(.*)\.types$/$1.xml/;
 176             } elsif ($mode eq "ann") {
 177                $filename_target =~ s/(.*)\.ann$/$1.xml/;
 178             }
 179             my $resolved = $map{$cicuri};
 180             my $resolved_target = $map{$target_to_annotate} if $do_annotate;
 181             if ($do_annotate) {
 182                print "GETWITHTYPES!!\n" if ($mode eq "types");
 183                print "GETWITHANN!!\n" if ($mode eq "ann");
 184                print "($cicuri, $target_to_annotate) ==> ($resolved + $resolved_target) ($filename)\n";
 185              } else {
 186                print "$cicuri ==> $resolved ($filename)\n";
 187             }
 188
 189             # Retrieves the annotation
 190
 191             if (stat($filename)) {
 192                print "Using local copy for the types\n" if ($mode eq "types");
 193                print "Using local copy for the ann\n" if ($mode eq "ann");
 194                open(FD, $filename);
 195                while(<FD>) { $cont .= $_; }
 196                close(FD);
 197             } else {
 198                print "Downloading the types\n" if ($mode eq "types");
 199                print "Downloading the ann\n" if ($mode eq "ann");
 200                $ua = LWP::UserAgent->new;
 201                $request = HTTP::Request->new(GET => "$resolved");
 202                $response = $ua->request($request, \&callback);
 203
 204                print "Storing file for the types\n" if ($mode eq "types");
 205                print "Storing file for the ann\n" if ($mode eq "ann");
 206                mkdirs($filename);
 207                open(FD, ">".$filename);
 208                print FD $cont;
 209                close(FD);
 210             }
 211             my $annotation = $cont;
 212
 213             # Retrieves the target to annotate
 214
 215             $cont = "";
 216             my $target;
 217             if ($do_annotate) {
 218                if (stat($filename_target)) {
 219                   print "Using local copy for the file to type\n";
 220                   open(FD, $filename_target);
 221                   while(<FD>) { $cont .= $_; }
 222                   close(FD);
 223                } else {
 224                   print "Downloading the file to type\n";
 225                   $ua = LWP::UserAgent->new;
 226                   $request = HTTP::Request->new(GET => "$resolved_target");
 227                   $response = $ua->request($request, \&callback);
 228
 229                   print "Storing file for the file to type\n";
 230                   mkdirs($filename_target);
 231                   open(FD, ">".$filename_target);
 232                   print FD $cont;
 233                   close(FD);
 234                }
 235                $target = $cont;
 236             } else {
 237                $target = $annotation;
 238                $annotation = "";
 239             }
 240
 241             # Merging the annotation and the target
 242
 243             $target =~ s/<\?xml [^?]*\?>//sg;
 244             $target =~ s/<!DOCTYPE [^>]*>//sg;
 245             $annotation =~ s/<\?xml [^?]*\?>//sg;
 246             $annotation =~ s/<!DOCTYPE [^>]*>//sg;
 247             my $element, $endelement;
 248             if ($mode eq "types") {
 249                $element = "<ALLTYPES>";
 250                $endelement = "</ALLTYPES>";
 251             } elsif ($mode eq "ann") {
 252                $element = "";
 253                $endelement = "";
 254             }
 255             my $merged = <<EOT;
 256 <?xml version="1.0" encoding="UTF-8"?>
 257 <cicxml uri="$target_to_annotate">
 258 $target
 259 $element
 260 $annotation
 261 $endelement
 262 </cicxml>
 263 EOT
 264
 265             # Answering the client
 266
 267             my $res = new HTTP::Response;
 268             $res->content($merged);
 269             $c->send_response($res);
 270          } elsif ($http_method eq 'GET' and $http_path eq "/getdtd") {
 271             my $filename = $cicuri;
 272             $filename = $dtd_dir."/".$filename;
 273             print "DTD: $cicuri ==> ($filename)\n";
 274             if (stat($filename)) {
 275                print "Using local copy\n";
 276                open(FD, $filename);
 277                while(<FD>) { $cont .= $_; }
 278                close(FD);
 279                my $res = new HTTP::Response;
 280                $res->content($cont);
 281                $c->send_response($res);
 282             } else {
 283                die "Could not find DTD!";
 284             }
 285         } elsif ($http_method eq 'GET' and $http_path eq "/conf") {
 286             my $quoted_html_link = $html_link;
 287             $quoted_html_link =~ s/&/&amp;/g;
 288             $quoted_html_link =~ s/</&lt;/g;
 289             $quoted_html_link =~ s/>/&gt;/g;
 290             $quoted_html_link =~ s/'/&apos;/g;
 291             $quoted_html_link =~ s/"/&quot;/g;
 292             print "Configuration requested, returned #$quoted_html_link#\n";
 293             $cont = "<?xml version=\"1.0\"?><html_link>$quoted_html_link</html_link>";
 294             my $res = new HTTP::Response;
 295             $res->content($cont);
 296             $c->send_response($res);
 297         } else {
 298             print "INVALID REQUEST!!!!!\n";
 299             $c->send_error(RC_FORBIDDEN)
 300         }
 301     }
 302     $c->close;
 303     undef($c);
 304     print "\nCONNECTION CLOSED\n\n";
 305     exit;
 306   } # fork
 307 }
 308
 309 #================================
 310
 311 sub callback
 312 {
 313  my ($data) = @_;
 314  $cont .= $data;
 315 }
 316
 317 # Does not raise errors if could not create dirs/files
 318
 319 # Too much powerful: creates even /home, /home/users/, ...
 320 sub mkdirs
 321 {
 322  my ($pathname) = @_;
 323  my @dirs = split /\//,$pathname;
 324  my $tmp;
 325  foreach $dir (@dirs) {
 326   $tmp = ((defined($tmp)) ?  $tmp = $tmp."\/".$dir : "");
 327   mkdir($tmp,0777);
 328  }
 329  rmdir($tmp);
 330 }