helm/interface/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
   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', '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) {
  26  if (fork() == 0) {
  27     while (my $r = $c->get_request) {
  28         #CSC: mancano i controlli di sicurezza
  29
  30         $cont = "";
  31         my $cicuri = $r->url;
  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";
  45                open(FD, $filename);
  46                while(<FD>) { $cont .= $_; }
  47                close(FD);
  48                my $res = new HTTP::Response;
  49                $res->content($cont);
  50                $c->send_response($res);
  51             } else {
  52                print "Downloading\n";
  53                $ua = LWP::UserAgent->new;
  54                $request = HTTP::Request->new(GET => "$resolved");
  55                $response = $ua->request($request, \&callback);
  56
  57                print "Storing file\n";
  58                mkdirs($filename);
  59                open(FD, ">".$filename);
  60                print FD $cont;
  61                close(FD);
  62
  63                my $res = new HTTP::Response;
  64                $res->content($cont);
  65                $c->send_response($res);
  66             }
  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;
  79             if ($do_annotate) {
  80                print "($cicuri, $target_to_annotate) ==> ($resolved + $resolved_target) ($filename)\n";
  81             } else {
  82                print "$cicuri ==> $resolved ($filename)\n";
  83             }
  84
  85             # Retrieves the annotation
  86
  87             if (stat($filename)) {
  88                print "Using local copy for the annotation\n";
  89                open(FD, $filename);
  90                while(<FD>) { $cont .= $_; }
  91                close(FD);
  92             } else {
  93                print "Downloading the annotation\n";
  94                $ua = LWP::UserAgent->new;
  95                $request = HTTP::Request->new(GET => "$resolved");
  96                $response = $ua->request($request, \&callback);
  97
  98                print "Storing file for the annotation\n";
  99                mkdirs($filename);
 100                open(FD, ">".$filename);
 101                print FD $cont;
 102                close(FD);
 103             }
 104             my $annotation = $cont;
 105
 106             # Retrieves the target to annotate
 107
 108             $cont = "";
 109             if ($do_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 .= $_; }
 114                   close(FD);
 115                } else {
 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);
 120
 121                   print "Storing file for the file to annotate\n";
 122                   mkdirs($filename_target);
 123                   open(FD, ">".$filename_target);
 124                   print FD $cont;
 125                   close(FD);
 126                }
 127             }
 128             my $target = $cont;
 129
 130             # Merging the annotation and the target
 131
 132             $target =~ s/<\?xml [^?]*\?>//sg;
 133             $target =~ s/<!DOCTYPE [^>]*>//sg;
 134             $annotation =~ s/<\?xml [^?]*\?>//sg;
 135             $annotation =~ s/<!DOCTYPE [^>]*>//sg;
 136             my $merged = <<EOT;
 137 <?xml version="1.0" encoding="UTF-8"?>
 138 <cicxml uri="$target_to_annotate">
 139 $target
 140 $annotation
 141 </cicxml>
 142 EOT
 143
 144             # Answering the client
 145
 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;
 161             if ($do_annotate) {
 162                print "GETWITHTYPES!!\n";
 163                print "($cicuri, $target_to_annotate) ==> ($resolved + $resolved_target) ($filename)\n";
 164              } else {
 165                print "$cicuri ==> $resolved ($filename)\n";
 166             }
 167
 168             # Retrieves the annotation
 169
 170             if (stat($filename)) {
 171                print "Using local copy for the types\n";
 172                open(FD, $filename);
 173                while(<FD>) { $cont .= $_; }
 174                close(FD);
 175             } else {
 176                print "Downloading the types\n";
 177                $ua = LWP::UserAgent->new;
 178                $request = HTTP::Request->new(GET => "$resolved");
 179                $response = $ua->request($request, \&callback);
 180
 181                print "Storing file for the types\n";
 182                mkdirs($filename);
 183                open(FD, ">".$filename);
 184                print FD $cont;
 185                close(FD);
 186             }
 187             my $annotation = $cont;
 188
 189             # Retrieves the target to annotate
 190
 191             $cont = "";
 192             my $target;
 193             if ($do_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 .= $_; }
 198                   close(FD);
 199                } else {
 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);
 204
 205                   print "Storing file for the file to type\n";
 206                   mkdirs($filename_target);
 207                   open(FD, ">".$filename_target);
 208                   print FD $cont;
 209                   close(FD);
 210                }
 211                $target = $cont;
 212             } else {
 213                $target = $annotation;
 214                $annotation = "";
 215             }
 216
 217             # Merging the annotation and the target
 218
 219             $target =~ s/<\?xml [^?]*\?>//sg;
 220             $target =~ s/<!DOCTYPE [^>]*>//sg;
 221             $annotation =~ s/<\?xml [^?]*\?>//sg;
 222             $annotation =~ s/<!DOCTYPE [^>]*>//sg;
 223             my $merged = <<EOT;
 224 <?xml version="1.0" encoding="UTF-8"?>
 225 <cicxml uri="$target_to_annotate">
 226 $target
 227 <ALLTYPES>
 228 $annotation
 229 </ALLTYPES>
 230 </cicxml>
 231 EOT
 232
 233             # Answering the client
 234
 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";
 244                open(FD, $filename);
 245                while(<FD>) { $cont .= $_; }
 246                close(FD);
 247                my $res = new HTTP::Response;
 248                $res->content($cont);
 249                $c->send_response($res);
 250             } else {
 251                die "Could not find DTD!";
 252             }
 253         } elsif ($http_method eq 'GET' and $http_path eq "/conf") {
 254             my $quoted_html_link = $html_link;
 255             $quoted_html_link =~ s/&/&amp;/g;
 256             $quoted_html_link =~ s/</&lt;/g;
 257             $quoted_html_link =~ s/>/&gt;/g;
 258             $quoted_html_link =~ s/'/&apos;/g;
 259             $quoted_html_link =~ s/"/&quot;/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);
 265         } else {
 266             print "INVALID REQUEST!!!!!\n";
 267             $c->send_error(RC_FORBIDDEN)
 268         }
 269     }
 270     $c->close;
 271     undef($c);
 272     print "\nCONNECTION CLOSED\n\n";
 273     exit;
 274   } # fork
 275 }
 276
 277 #================================
 278
 279 sub callback
 280 {
 281  my ($data) = @_;
 282  $cont .= $data;
 283 }
 284
 285 # Does not raise errors if could not create dirs/files
 286
 287 # Too much powerful: creates even /home, /home/users/, ...
 288 sub mkdirs
 289 {
 290  my ($pathname) = @_;
 291  my @dirs = split /\//,$pathname;
 292  my $tmp;
 293  foreach $dir (@dirs) {
 294   $tmp = ((defined($tmp)) ?  $tmp = $tmp."\/".$dir : "");
 295   mkdir($tmp,0777);
 296  }
 297  rmdir($tmp);
 298 }