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                open(FD, $filename);
  59                print FD $cont;
  60                close(FD);
  61
  62                my $res = new HTTP::Response;
  63                $res->content($cont);
  64                $c->send_response($res);
  65             }
  66         } elsif ($http_method eq 'GET' and $http_path eq "/annotate") {
  67             my $do_annotate = ($cicuri =~ /\.ann$/);
  68             my $target_to_annotate = $cicuri;
  69             $target_to_annotate =~ s/(.*)\.ann$/$1/ if $do_annotate;
  70             my $filename = $cicuri;
  71             $filename =~ s/cic:(.*)/$1/;
  72             $filename =~ s/theory:(.*)/$1/;
  73             my $filename_target = $helm_dir.$filename if $do_annotate;
  74             $filename = $helm_dir.$filename.".xml";
  75             $filename_target =~ s/(.*)\.ann$/$1.xml/ if $do_annotate;
  76             my $resolved = $map{$cicuri};
  77             my $resolved_target = $map{$target_to_annotate} if $do_annotate;
  78             if ($do_annotate) {
  79                print "($cicuri, $target_to_annotate) ==> ($resolved + $resolved_target) ($filename)\n";
  80             } else {
  81                print "$cicuri ==> $resolved ($filename)\n";
  82             }
  83
  84             # Retrieves the annotation
  85
  86             if (stat($filename)) {
  87                print "Using local copy for the annotation\n";
  88                open(FD, $filename);
  89                while(<FD>) { $cont .= $_; }
  90                close(FD);
  91             } else {
  92                print "Downloading the annotation\n";
  93                $ua = LWP::UserAgent->new;
  94                $request = HTTP::Request->new(GET => "$resolved");
  95                $response = $ua->request($request, \&callback);
  96
  97                print "Storing file for the annotation\n";
  98                open(FD, $filename);
  99                print FD $cont;
 100                close(FD);
 101             }
 102             my $annotation = $cont;
 103
 104             # Retrieves the target to annotate
 105
 106             $cont = "";
 107             if ($do_annotate) {
 108                if (stat($filename_target)) {
 109                   print "Using local copy for the file to annotate\n";
 110                   open(FD, $filename_target);
 111                   while(<FD>) { $cont .= $_; }
 112                   close(FD);
 113                } else {
 114                   print "Downloading the file to annotate\n";
 115                   $ua = LWP::UserAgent->new;
 116                   $request = HTTP::Request->new(GET => "$resolved_target");
 117                   $response = $ua->request($request, \&callback);
 118
 119                   print "Storing file for the file to annotate\n";
 120                   open(FD, $filename_target);
 121                   print FD $cont;
 122                   close(FD);
 123                }
 124             }
 125             my $target = $cont;
 126
 127             # Merging the annotation and the target
 128
 129             $target =~ s/<\?xml [^?]*\?>//sg;
 130             $target =~ s/<!DOCTYPE [^>]*>//sg;
 131             $annotation =~ s/<\?xml [^?]*\?>//sg;
 132             $annotation =~ s/<!DOCTYPE [^>]*>//sg;
 133             my $merged = <<EOT;
 134 <?xml version="1.0" encoding="UTF-8"?>
 135 <cicxml uri="$target_to_annotate">
 136 $target
 137 $annotation
 138 </cicxml>
 139 EOT
 140
 141             # Answering the client
 142
 143             my $res = new HTTP::Response;
 144             $res->content($merged);
 145             $c->send_response($res);
 146         } elsif ($http_method eq 'GET' and $http_path eq "/getwithtypes") {
 147             my $do_annotate = ($cicuri =~ /\.types$/);
 148             my $target_to_annotate = $cicuri;
 149             $target_to_annotate =~ s/(.*)\.types$/$1/ if $do_annotate;
 150             my $filename = $cicuri;
 151             $filename =~ s/cic:(.*)/$1/;
 152             $filename =~ s/theory:(.*)/$1/;
 153             my $filename_target = $helm_dir.$filename if $do_annotate;
 154             $filename = $helm_dir.$filename.".xml";
 155             $filename_target =~ s/(.*)\.types$/$1.xml/ if $do_annotate;
 156             my $resolved = $map{$cicuri};
 157             my $resolved_target = $map{$target_to_annotate} if $do_annotate;
 158             if ($do_annotate) {
 159                print "GETWITHTYPES!!\n";
 160                print "($cicuri, $target_to_annotate) ==> ($resolved + $resolved_target) ($filename)\n";
 161              } else {
 162                print "$cicuri ==> $resolved ($filename)\n";
 163             }
 164
 165             # Retrieves the annotation
 166
 167             if (stat($filename)) {
 168                print "Using local copy for the types\n";
 169                open(FD, $filename);
 170                while(<FD>) { $cont .= $_; }
 171                close(FD);
 172             } else {
 173                print "Downloading the types\n";
 174                $ua = LWP::UserAgent->new;
 175                $request = HTTP::Request->new(GET => "$resolved");
 176                $response = $ua->request($request, \&callback);
 177
 178                print "Storing file for the types\n";
 179                open(FD, $filename);
 180                print FD $cont;
 181                close(FD);
 182             }
 183             my $annotation = $cont;
 184
 185             # Retrieves the target to annotate
 186
 187             $cont = "";
 188             my $target;
 189             if ($do_annotate) {
 190                if (stat($filename_target)) {
 191                   print "Using local copy for the file to type\n";
 192                   open(FD, $filename_target);
 193                   while(<FD>) { $cont .= $_; }
 194                   close(FD);
 195                } else {
 196                   print "Downloading the file to type\n";
 197                   $ua = LWP::UserAgent->new;
 198                   $request = HTTP::Request->new(GET => "$resolved_target");
 199                   $response = $ua->request($request, \&callback);
 200
 201                   print "Storing file for the file to type\n";
 202                   open(FD, $filename_target);
 203                   print FD $cont;
 204                   close(FD);
 205                }
 206                $target = $cont;
 207             } else {
 208                $target = $annotation;
 209                $annotation = "";
 210             }
 211
 212             # Merging the annotation and the target
 213
 214             $target =~ s/<\?xml [^?]*\?>//sg;
 215             $target =~ s/<!DOCTYPE [^>]*>//sg;
 216             $annotation =~ s/<\?xml [^?]*\?>//sg;
 217             $annotation =~ s/<!DOCTYPE [^>]*>//sg;
 218             my $merged = <<EOT;
 219 <?xml version="1.0" encoding="UTF-8"?>
 220 <cicxml uri="$target_to_annotate">
 221 $target
 222 <ALLTYPES>
 223 $annotation
 224 </ALLTYPES>
 225 </cicxml>
 226 EOT
 227
 228             # Answering the client
 229
 230             my $res = new HTTP::Response;
 231             $res->content($merged);
 232             $c->send_response($res);
 233          } elsif ($http_method eq 'GET' and $http_path eq "/getdtd") {
 234             my $filename = $cicuri;
 235             $filename = $helm_dir."/dtd/".$filename;
 236             print "DTD: $cicuri ==> ($filename)\n";
 237             if (stat($filename)) {
 238                print "Using local copy\n";
 239                open(FD, $filename);
 240                while(<FD>) { $cont .= $_; }
 241                close(FD);
 242                my $res = new HTTP::Response;
 243                $res->content($cont);
 244                $c->send_response($res);
 245             } else {
 246                die "Could not find DTD!";
 247             }
 248         } elsif ($http_method eq 'GET' and $http_path eq "/conf") {
 249             my $quoted_html_link = $html_link;
 250             $quoted_html_link =~ s/&/&amp;/g;
 251             $quoted_html_link =~ s/</&lt;/g;
 252             $quoted_html_link =~ s/>/&gt;/g;
 253             $quoted_html_link =~ s/'/&apos;/g;
 254             $quoted_html_link =~ s/"/&quot;/g;
 255             print "Configuration requested, returned #$quoted_html_link#\n";
 256             $cont = "<?xml version=\"1.0\"?><html_link>$quoted_html_link</html_link>";
 257             my $res = new HTTP::Response;
 258             $res->content($cont);
 259             $c->send_response($res);
 260         } else {
 261             print "INVALID REQUEST!!!!!\n";
 262             $c->send_error(RC_FORBIDDEN)
 263         }
 264     }
 265     $c->close;
 266     undef($c);
 267     print "\nCONNECTION CLOSED\n\n";
 268     exit;
 269   } # fork
 270 }
 271
 272 #================================
 273
 274 sub callback
 275 {
 276  my ($data) = @_;
 277  $cont .= $data;
 278 }