# # Dick Munroe (munroe@csworks.com) # # The following performs a simple conversion from an OSU specific # CGI to a "server neutral" framework that can run (more or less) # unchanged under: # # 1. OSU # 2. WASD with OSU emulation. # 3. WASD with (sub)processes. # # The script was designed to do a "good" not perfect job of # conversion. In other works, the output must be checked to make # sure that it REALLY does what you want. It may also need to be # slightly modified to process your cgis as the coding # conventions at your site are probably different from ours. # # Run it like this: # # perl framework.pl < cgi.com > convertedcgi.com # my @theFile ; my @theStandard ; sub dcl { my $theLine = shift ; return '$ ' . $theLine . "\n" ; } sub update { my $theLine = shift ; undef @theStandard ; push @theFile,dcl('theDecnetFlag = (f$type(wwwexec_rundown_string) .nes. "")') ; push @theFile,dcl('if (theDecnetFlag)') ; push @theFile,dcl('then') ; push @theFile,dcl(' nl = f$fao("!/") ! CR/LF sequence') ; push @theFile,dcl(' say = "write net_link"') ; push @theFile,dcl(' say "" ! Set implied carriage control.') ; push @theFile,dcl(' cgisymbols := $cgi-bin:[000000]osu-cgi_symbols.exe') ; push @theFile,$theLine ; push @theFile,dcl('else') ; push @theFile,dcl(' say = "write sys$output"') ; push @theFile,dcl(' cgiutl := $cgi-bin:[000000]cgiutl.exe') ; my $theCgiutlLine = $theLine ; $theCgiutlLine =~ s{cgisymbols}{cgiutl /URLDECODE /SYMBOL} ; $theCgiutlLine =~ s{[ \t]{2,}}{ }g ; $theCgiutlLine =~ s{"www_"\s+}{}i ; $theCgiutlLine =~ s{^\$ }{\$ } ; $theCgiutlLine =~ s{([^\s]+)='([^' ]+)'{0,1}}{/FIELD=$1 /OUTPUT=*$2}g ; if ($theCgiutlLine =~ s{([^\s]+)>'([^' ]+)'{0,1}}{/FIELD=$1 /OUTPUT=*$2}g) { $theCgiutlLine =~ s{URLDECODE}{MULTIPART} ; } $theCgiutlLine =~ s{([^\s]+)=([^ \.]+\.[^ ]+)}{/FIELD=$1 /OUTPUT=$2}g ; if ($theCgiutlLine =~ s{([^\s]+)>([^ \.]+\.[^ ]+)}{/FIELD=$1 /OUTPUT=$2}g) { $theCgiutlLine =~ s{URLDECODE}{MULTIPART} ; } $theCgiutlLine =~ s{\"(.*?)\"}{/PREFIX=$1FLD}i ; if ($theCgiutlLine =~ m/\@/) { print STDERR 'Manual intervention is necessary due to @ in CGIUTL invocation',"\n" ; $theCgiutlLine =~ s{URLDECODE}{MULTIPART} ; my $theDefineLine = $theCgiutlLine ; $theDefineLine =~ s{cgiutl}{DEFINE/USER CGIUTL\$PARAM}i ; $theDefineLine =~ s{("\@'*.*?'*")}{} ; push @theFile,$theDefineLine ; push @theFile,'$ DEFINE/USER CGIUTL$PARAM_1 ' . $1 . "\n" ; $theCgiutlLine = '$ cgiutl' . "\n" ; } $theCgiutlLine =~ s{/FIELD}{-\n /FIELD}gi ; $theCgiutlLine =~ s{^\$\s*}{ } ; push @theFile,'$ if (f$type(theNotAFormFlag) .eqs. "") then -' . "\n" ; push @theFile,$theCgiutlLine ; push @theFile,dcl('endif') ; push @theFile,dcl('') ; push @theFile,dcl('theOSUFlag = (f$extract(0,3,www_server_software) .eqs. "OSU")') ; push @theFile,dcl('theVerifyFlag = (f$trnlnm("httpd$verify") .nes. "")') ; push @theFile,dcl('theWASDFlag = (f$extract(0,10,www_server_software) .eqs. "HTTPd-WASD")') ; push @theFile,dcl('if (theWASDFlag) .and. (.not. theVerifyFlag)') ; push @theFile,dcl('then') ; push @theFile,dcl(' set message /nofacility /noidentification /noseverity /notext') ; push @theFile,dcl('endif') ; push @theFile,dcl('if (theVerifyFlag)') ; push @theFile,dcl('then') ; push @theFile,dcl(' if (theDecnetFlag)') ; push @theFile,dcl(' then') ; push @theFile,dcl(' say "Content-type: text/plain",nl,nl') ; push @theFile,dcl(' define sys$output net_link:') ; push @theFile,dcl(' set verify') ; push @theFile,dcl(' endif') ; push @theFile,dcl(' show symbol/global/all') ; push @theFile,dcl(' show symbol/local/all') ; push @theFile,dcl('endif') ; } ; use strict ; my $theEnvironmentFlag = 1 ; my $theExitFlag = 1 ; my $theFormFlag = 1 ; my $theLine ; my $theLocationFlag = 0 ; my $theNlFlag = 0 ; my $theSayFlag = 0 ; while (defined($theLine = )) { $theExitFlag = 1 ; if ($theLine =~ m/^\$\s*exit/i) { $theExitFlag = 0 ; } elsif ($theLine =~ m/f\$length\(www_path_info\)/i) { push @theStandard,'$ theNotAFormFlag = 1' . "\n" if ($theFormFlag) ; $theFormFlag = 0 ; } elsif ($theLine =~ s{say\s+"location:\s+}{call location "}) { if ((! $theLocationFlag) && ($theEnvironmentFlag)) { push @theStandard,'$ nl = f$fao("!/")' . "\n" if (! $theNlFlag) ; push @theStandard,'$ say = "write net_link"' . "\n" if (! $theSayFlag) ; push @theStandard,'$ cgisymbols := $cgi-bin:[000000]osu-cgi_symbols.exe' . "\n" ; push @theStandard,'$ cgiutl := $cgi-bin:[000000]cgiutl.exe' . "\n" ; } ; $theLine =~ s{,nl,nl}{} ; $theLocationFlag = 1 ; } elsif ($theLine =~ s{^\$\s*[mcr]*\s*cgi-bin:\[000000\]osu-cgi_symbols[\.ex]*}{\$ cgisymbols}i) { if ($theEnvironmentFlag) { update($theLine) ; $theEnvironmentFlag = 0 ; next ; } } elsif ($theLine =~ s{^\$\s*[mcr]*\s*www_root:\[bin\]cgi_symbols[\.ex]*}{\$ cgisymbols}i) { if ($theEnvironmentFlag) { update($theLine) ; $theEnvironmentFlag = 0 ; next ; } } elsif ($theLine =~ m/^(\$\s*)run/i) { push @theFile,$1,'if (theDecnetFlag) then define/user sys$output net_link:',"\n" if (! $theEnvironmentFlag) ; } else { if ($theLine =~ m/^\$\s*nl\s*=\s*f\$fao/i) { push @theStandard,$theLine ; $theNlFlag = 1 ; next ; } elsif ($theLine =~ m/^\$\s*say\s*=\s*"write/i) { push @theStandard,$theLine ; $theSayFlag = 1 ; next ; } elsif ($theLine =~ m/^\$\s*say\s*""/i) { push @theStandard,$theLine ; next ; } elsif ($theLine =~ m/^\$\s*write\s*net_link\s*""/i) { push @theStandard,'$ nl = f$fao("!/")' . "\n" if (! $theNlFlag) ; push @theStandard,'$ say = "write net_link"' . "\n" if (! $theSayFlag) ; push @theStandard,'$ say ""' . "\n" ; $theNlFlag = 1 ; $theSayFlag = 1 ; next ; } else { next if (($theLine =~ m/^\$\s*define.*?sys\$output.*?net_link/i) && (! $theEnvironmentFlag)) ; } } ; push @theFile,$theLine ; } ; print join '',@theStandard if (@theStandard) ; print join '',@theFile ; exit() if (($theEnvironmentFlag) && (!$theLocationFlag)) ; if ($theExitFlag) { print dcl('') ; print dcl('exit') ; } if ($theLocationFlag) { print dcl('') ; print dcl('Location: subroutine') ; print dcl('if (theDecnetFlag)') ; print dcl('then say "Location: " + P1,nl,nl') ; print dcl('else cgiutl /location=*p1') ; print dcl('endif') ; print dcl('exit') ; print dcl('endsubroutine') ; }