#!/usr/bin/env perl # $URL: http://saturn/svn/das2/das2Server/trunk/das2Server $ # $Revision: 5525 $ use CGI; use strict; my $query = new CGI; my $webhome = '/home/jbf/ct/pw/das2serverhome'; my $suffix = (time / 86400) % 3; my $logfile = $webhome.'/tmp/das2.'.$query->remote_addr().'_'.$suffix.'.log'; my $log_id = (localtime).' '.$$; # Name of area where das access info, etc is kept my $dasHome = '/home/jbf/ct/pw/das2serverhome'; my $das2UtilBin = "$dasHome/das2StreamUtil"; my $das1ToDas2 = "$das2UtilBin/das1ToDas2"; my $prepender = "/opt/project/das2/server/bin/prepender"; # SETUP LOG FILE # In order for this log file to be passed to child process as STDERR, # STDERR must first be closed, then opened as the log file. # LOG is set to STDERR to support legacy code in this file that # explicitly writes to LOG close(STDERR); open(STDERR, "| $prepender '$log_id' $logfile") or &PrintErrorExit ("Cannot open log file $logfile"); *LOG = *STDERR; # O'Reilly Programming Perl 3rd Ed. pg 781 select((select(STDERR), $| = 1)[0]); print LOG $query->url; print LOG '?'; print LOG $query->query_string; print LOG "\n"; print LOG "$0\n"; my $version; my $server = $query->param('server'); ## the output of all CGIs should be unbuffered --Ed. #$|=1; # unbuffered causes a write failure, and causes the das2Stream library to exit. if ( $server eq "compactdataset" ) { $server= "dataset"; } #my $redirect= $query->param('redirect'); #if ( $redirect eq "1" ) { # my $query_string= $query->query_string; # $query_string =~ 's/&redirect=1//'; # my $newUrl= "http://www-pw.physics.uiowa.edu/das/das2Server?".$query_string; # print 'Status: 302 Moved', "\r\n", 'Location: '.$newUrl, "\r\n\r\n"; #} if ( $server eq "" ) { print $query->header(-type=>"text/html"); print "

"; print "url . "?server=logo"."\"> "; open(NAME,$dasHome."/identity/name.txt"); while() { print $_; } close(NAME); print "

"; print "This is a das2Server.
"; print "More information about das2 can be found at "; print "http://www-pw.physics.uiowa.edu/das2/.

"; print "Bad server keyword. Server must be [dataset|dsdf|authenticator|groups|compactDataSet|logo|id|list|discovery]\n"; print "\n"; print "\n"; exit(0); } elsif ($server eq "dsdf") { my $dataset = $query->param('dataset'); open(DSDF,getDataSetRoot().$dataset) || throwNoSuchDataSetException(); my %dsdf= readDataSetDescriptor($dataset); print LOG length(%dsdf->{"groupAccess"}); print LOG "\n"; qdPacketDescriptor( dsdfToDas2StreamHeader( %dsdf ) ); exit(0); } elsif ($server eq "list") { #open(DSDFLIST,"cd ".getDataSetRoot()."; ls -1dF `find . -name '*' -print | cut -c3-999`|"); #print $query->header(-type=>"text/plain"); #while () { #print $_; #} #close (DSDFLIST); #exit(0); print $query->header(-type=>"text/plain"); my $root = getDataSetRoot(); opendir(DSDFDIR, $root); my @files = sort {$b cmp $a} readdir(DSDFDIR); closedir(DSDFDIR); my @filestack = (); foreach (@files) { next if ($_ =~ m/^\./); push(@filestack, $_); } while (@filestack) { my $file = pop(@filestack); if (-d "$root/$file") { print "$file/\n"; opendir(DSDFDIR, "$root/$file"); @files = sort {$b cmp $a} readdir(DSDFDIR); closedir(DSDFDIR); foreach (@files) { next if ($_ =~ /^\./); push(@filestack, "$file/$_"); } } else { print "$file\n"; } } exit(0); } elsif ($server eq "discovery") { print $query->header(-type=>"text/plain"); my $root = getDataSetRoot(); opendir(DSDFDIR, $root); my @files = sort {$b cmp $a} readdir(DSDFDIR); closedir(DSDFDIR); my @filestack = (); foreach (@files) { next if ($_ =~ m/^\./); push(@filestack, $_); } my $parent=""; # TODO: this assumes that a directory only contains files and no subdirectories. while (@filestack) { my $file = pop(@filestack); if (-d "$root/$file") { $parent= "$file/"; opendir(DSDFDIR, "$root/$file"); @files = sort {$b cmp $a} readdir(DSDFDIR); closedir(DSDFDIR); foreach (@files) { next if ($_ =~ /^\./); push(@filestack, "$file/$_"); } } else { if ( isDiscovery( $file ) ) { if ( $parent ) { print "$parent\n"; $parent=""; } print "$file\n"; } } } exit(0); } elsif ( $server eq "logo") { open(LOGO,$dasHome."/identity/logo.gif"); print $query->header(-type=>"image/gif"); while() { print $_; } close(LOGO); exit(0); } elsif ($server eq "id") { open(NAME,$dasHome."/identity/name.txt"); print $query->header(-type=>"text/plain"); while() { print $_; } close(NAME); exit(0); } elsif ($server eq "authenticator") { my $user= $query->param('user'); my $passwd= $query->param('passwd'); my $key= authenticateUser($user,$passwd); if ( substr($key,0,1) ne "-") { print $query->header(-type=>"text/plain"); print "".$key.""; } else { print $query->header(-type=>"text/plain"); print ""; } } elsif ($server eq "groups" ) { # return the groups accessible with this key my $key= $query->param("key"); print $query->header(-type=>"text/plain"); print "".keyGroups($key).""; } elsif ($server eq "changePassword") { my $user= $query->param('user'); my $oldPasswd= $query->param('passwd'); my $newPasswd= $query->param('newPasswd'); my $key= authenticateUser($user,$oldPasswd); if ( substr($key,0,1) ne "-") { changePassword( $user, $oldPasswd, $newPasswd ); print $query->header(-type=>"text/plain"); print ""; } else { print $query->header(-type=>"text/plain"); print ""; } } elsif ($server eq "dataset") { # returns das2Stream my $dataset = $query->param('dataset'); my $start_time = $query->param('start_time'); my $end_time = $query->param('end_time'); my $params = $query->param('params'); my $resolution = $query->param('resolution'); my $nitems = $query->param('nitems'); my $compress = $query->param('compress'); my $interval = $query->param('interval'); my $ascii= $query->param('ascii'); my $devel= $query->param('devel'); my %dsdf= readDataSetDescriptor($dataset); my $reServer= %dsdf->{'server'}; if ($reServer ne "" and $reServer ne $query->url) { my $reUrl = $reServer.'?'.$query->query_string; print LOG "Redirecting\n"; print LOG $query->redirect($reUrl); print $query->redirect($reUrl); exit(0) } my $defaultDas2StreamReducer= "/opt/project/das2/das2StreamUtil/binAverageSeconds"; my $das2StreamReducer; if ( %dsdf->{"reducer"} ne "" ) { print LOG "explicit reducer =".%dsdf->{"reducer"}."\n"; $das2StreamReducer= %dsdf->{"reducer"}; } else { print LOG "using default reducer =".%dsdf->{"reducer"}."\n"; $das2StreamReducer= $defaultDas2StreamReducer; } if ( %dsdf->{"reducer"} eq "not_reducable" ) { print LOG "dsdf reducer=not_reducable disallows reduction, clearing resolution\n"; $resolution=""; } elsif ( %dsdf->{"reducer"} =~ m/not/ ) { print LOG "REDUCER STARTS WITH not, but isnt not_reducable!!!\n"; } my $cmdstr; if ( %dsdf->{"das2Stream"} eq "1" || %dsdf->{"qstream"} eq "1") { my $reader= %dsdf->{"reader"}; if ( $devel ne "" ) { if ( index( $reader, $dasHome ) == 0 ) { print LOG "changing over to devel version of reader"; $reader= "/home/".$devel. substr($reader,length($dasHome)); } } $cmdstr= $reader . " $interval '$start_time' '$end_time' '$params' | " ; } else { $das2StreamReducer= $defaultDas2StreamReducer; my $dataSetRoot= getDataSetRoot(); if ( %dsdf->{"items"} ne "" ) { # isTCA $cmdstr= "$das1ToDas2 $dataSetRoot/$dataset $start_time $end_time $interval"; } else { $cmdstr= "$das1ToDas2 $dataSetRoot/$dataset $start_time $end_time"; } if ($params=~/\S+/) { $cmdstr = $cmdstr." '$params'"; } $cmdstr = $cmdstr." | "; } if ( %dsdf->{"uri"} ne "" ) { print ${start_time} .'/' . ${end_time}; $cmdstr= "/opt/project/das2/bin/autoplotServer '" . %dsdf->{"uri"} . "' '" . ${start_time} .'/' . ${end_time} ; $cmdstr= $cmdstr . "' |"; print LOG "###\n"; print $cmdstr . '\n'; print LOG "###\n"; } ## Resolution only matters for das2Streams if ( !%dsdf->{"qstream"} eq "1" && $resolution ne "" ) { $cmdstr.= $das2StreamReducer . " $resolution 2>/dev/null |"; } ## toAscii only works on das2Streams if ( !%dsdf->{"qstream"} eq "1" && $ascii ne "" ) { $cmdstr.= "/opt/project/das2/das2StreamUtil/toAscii |"; } if ( %dsdf->{"groupAccess"} ne "" ) { my $key= $query->param("key"); if ( $key eq "" ) { throwException( "needKey" ); } else { if ( authenticateKey($key,%dsdf->{"groupAccess"}) eq "0" ) { throwException("accessDenied"); } } } if( $compress eq "true" ) { if ( %dsdf->{"das2Stream"} eq "1" ) { $cmdstr= $cmdstr. " /opt/project/das2/das2StreamUtil/deflateStream |" } else { $cmdstr= $cmdstr. %dsdf->{"compressor"} ." |"; } }; print LOG $cmdstr."\n"; open( INF, $cmdstr ) || &PrintErrorExit( "couldn't open reader" ); my $buffer; my $status; if ($status=read(INF,$buffer,4096)) { print $query->header(-type=>'application/octet-stream', -status=>'200 Binary data follows', -expires=>'now', -Content_Disposition=>'inline;filename=default.das2Stream'); print $buffer; while ($status=read(INF,$buffer,4096)) { #my $len= syswrite( stdout, $buffer, 4096 ); print $buffer; #print LOG "bytes written: ".$len; } } else { throwException( "EmptyResponseFromReader" ); } close(INF); exit(0); } else { print <) { print $_; } close(NAME); print "\n"; print "Bad server keyword. Server must be [dataset|dsdf|authenticator|compactDataSet|logo|id|list|discovery]\n"; } sub throwException { my ($type)= @_; my $length= length( $type ); my $totalLength= $length + 16 + 5; print LOG "throwing exception of type ".$type; print $query->header(-type=>'application/octet-stream', -expires=>'now', -Content_Disposition=>'inline;filename=exception.das2Stream' ); printf "[00]%6.6d", $totalLength, $type; exit(0); } sub qdPacketDescriptor { my ($descriptorXML)= @_; my $totalLength= length( $descriptorXML ); print $query->header(-type=>'text/plain', -expires=>'now'); printf "[00]%6.6d%s", $totalLength, $descriptorXML; } sub throwNoSuchDataSetException{ throwException( "noSuchDataSet" ); } sub readDataSetDescriptor{ my ($dataset)= @_; my %result; open(DSDF,getDataSetRoot().$dataset) || throwNoSuchDataSetException(); while () { my @ss= split( '=', $_, 2 ); # this allows equals signs to appear in the value. my $key= @ss[0]; my $value1= @ss[1]; my @ss= split( ';', $value1 ); my $value= @ss[0]; $key=~ s/\s//g; $value=~ s/\'//g; $value=~ s/^\s//g; $value=~ s/\s$//g; print LOG ":$key=$value:\n"; %result->{$key} = $value; } close(DSDF); print LOG "das2Stream=".%result->{"das2Stream"}."\n"; if ( %result->{"das2Stream"} eq "" ) { %result->{"das2Stream"}= "0"; } if ( !defined( %result->{"reducer"} ) ) { if ( %result->{"das2Stream"} eq "1" ) { %result->{"reducer"}= getDefaultDas2StreamReducer(); } else { %result->{"reducer"}= getDefaultDas1StreamReducer(); } } if ( %result->{"compressor"} eq "" ) { if ( %result->{"das2Stream"} eq "1" ) { %result->{"compressor"}= $dasHome."/util/bin/d2sCompress"; } else { %result->{"compressor"}= "zip"; } } return %result; } sub dsdfToDas2StreamHeader( ) { my %dsdf= @_; my $ss= " ) { ($u,$p)= split /:/; if ($u eq $user) { chop $p; last; } } close(PASSWD); my $remoteHost= $ENV{'REMOTEHOST'}; if ($p eq $passwd) { return generateSessionKey($user,$remoteHost); } else { return "-1 bad user/password"; } } sub changePassword { print "in change password"; my ($user,$oldPassword,$newPassword)= @_; open(PASSWD,"$dasHome/server/passwd") || &PrintErrorExit( "can't open passwd file" ); open(PASSWDNEW,">$dasHome/server/passwd.1") || &PrintErrorExit( "can't open new passwd file" ); while () { print $_; if (/^$user/) { print PASSWDNEW "$user:$newPassword\n"; } else { print PASSWDNEW $_; } } close(PASSWD); close(PASSWDNEW); open(PROG,"mv $dasHome/server/passwd.1 $dasHome/server/passwd|"); close(PROG); } sub generateSessionKey { my ($user,$machine)= @_; my $keyname= (int(rand(1000000))+33000000); open(KEYFILE,"> ".$dasHome."/server/session/".$keyname.'.session'); # or die... print KEYFILE "user=".$user."\n"; print KEYFILE "machine=".$machine."\n"; close(KEYFILE); return $keyname; } # return a list of groups that the key can access sub keyGroups { my ($key)= @_; my $keyData= keyLookup($key); my $user= $keyData->{"user"}; open(GROUP, $dasHome."/server/group"); my $result=""; while () { if (/[:,]$user,/) { print LOG $_; my ($g,$_x1,$_x2,$users)= split(":",$_); $result.=$g.","; } } close(GROUP); return $result; } sub authenticateKey { my $access=0; my ($key,$group)= @_; my $keyData= keyLookup($key); my $remoteHost= $keyData->{"remoteHost"}; if ( $remoteHost ne $ENV{"REMOTEHOST"} ) { print $query->header(-type=>'application/octet-stream', -status=>'200 Binary data follows',-expires=>'now'); print ""; exit(0); } my $user= $keyData->{"user"}; open(GROUP, $dasHome."/server/group"); while () { if (/$group/) { print LOG $_; my ($g,$_x1,$_x2,$users)= split(":",$_); my @users= split(",",$users); my $i; foreach $i (@users) { $i=~s/\s//g; if ($i eq $user) { $access=1; } } } } close(GROUP); return $access; } sub keyLookup { # return hash of this key's info my ( $key )= @_; my $result; $result->{"valid"} = 0; open(KEYFILE,$dasHome."/server/session/".$key.".session"); while () { $result->{"valid"}= 1; my @ss= split( '=', $_ ); my $value= @ss[1]; chop $value; if (/^user/) { $result->{"user"} = $value; } if (/^remoteHost/) { $result->{"remoteHost"} = $value; } } close(KEYFILE); if ( $result->{"valid"} eq 0 ) { print $query->header(-type=>'application/octet-stream', -status=>'200 Binary data follows',-expires=>'now'); print ""; exit(0); } # touch the file open(PROG,"touch ".$dasHome."/server/session/".$key.".session|"); close(PROG); return $result; } sub checkExpiredKeys { # remove any expired keys open(PROG,$dasHome."/server/bin/checkExpiredKeys|"); close(PROG); } #----------------------------------------------------------------------------- # # UTILITY SUBROUTINES (put your own e-mail and web info here!) # #----------------------------------------------------------------------------- sub PrintHeader { print $query->header; print $query->start_html (-title=>$version, -author=>'jeremy-faden@uiowa.edu'); } sub PrintTrailer { print < EOH print $query->end_html; } sub PrintErrorExit { &PrintHeader; print "

ERROR: $_[0]

\n"; print "

Contents of log file:

\n";
  close(LOG);
  if (open(LOG, "<$logfile") ) {
      print ;
  }
  else {
      print "Cannot open log file.\n"
  }
  close(LOG);
  print "\n

\n"; &PrintTrailer; exit 0; } # return 1 (true) if the dataset id contains example range that is guarenteed to work. sub isDiscovery { my ( $dsdf )= @_; #print LOG $dasHome.'/dataSetRoot/'.$dsdf; open(DSDF,$dasHome.'/dataSetRoot/'.$dsdf); while ( ) { my $line= $_; if ( $line =~ 'exampleRange' ) { return 1; } } return 0; }