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