#!/usr/local/bin/perl

$Script = 'sascgi'; 
$Version=1.10;  # 31 Mar 1997 11:27:35
$ScriptDocURL= 'http://www.math.yorku.ca/SCS/Online/sascgi/';
$ScriptIcon  = '<img height=50 src="http://www.math.yorku.ca/SCS/Online/sascgi/sascgi.gif">';

$ScriptAuthor='<a href="http://www.math.yorku.ca/SCS/friendly.html">Michael Friendly</a> (friendly@yorku.ca)';

# sascgi is a perl script designed to provide a gateway between a web
# server and a SAS program which returns results to the browser via
# stdout, a listing file, or graphic image(s).  The output may be 
# interpolated into an 'output form', which can be defined for each
# application.

# The intention is to provide a relatively uncluttered, general
# protocfol for running SAS on the web.  The script handles most of
# the interaction with the web server, making it much easier to
# write SAS applications to be run on the web.  

# The script passes input parameters to the sas program via the
# environment, which is much easier than trying to parse server queries
# in SAS.  
# The SAS program is assumed to retrieve these parameters
# via %sysget(PARAM), or sysget('PARAM') in a data step.

# The SAS program can communicate success or failure (with an error message)
# by writing a message to a .err file or by returning a message starting
# with 'ERROR:' to stdout. [Not yet implemented]

# Usage: 
# Embed a <form> ... </form> block inside an HTML document, referencing
# this script as follows:
# <form method="POST" 
#   action="http://your.server.name/cgi-bin/sascgi"> 
#  	<input type="hidden" name="SASFILE" value="getlist.sas">
#  	<input type="hidden" name="CONFIG" value="getlist.cfg">
#  	<input type="hidden" name="TITLE" value="Page title">
#  	<input type="hidden" name="OUTPUT_METHOD" value="STDOUT|LST|IMAGE">
#  	<input type="hidden" name="REQUIRE" value="ITEMS LISTS">

#     ... other form elements ... 
#		These define names of parameters/arguments passed to the
#		SAS program (via setenv).  
#		Multi-valued arguments (<SELECT MULTIPLE>) are formatted
#		as a comma-separated string, surrounded by braces.
# </form>

#	Only query items which are given a value in the form are placed
#	in the SAS environment. %sysget() will give a harmless warning if
#	the SAS program references an unset (null) string.

#	Note that *names* of query items passed from a form are case-sensitive
#	The values of these query items are generally case-insensitive.

#	Output methods presently handled: STDOUT and LST and IMAGE.  
#   OUTPUT_METHOD = STDOUT assumes the SAS program produces output
#			which can be sent directly to the browser, e.g., as wrapped
#			with HTML tags like <PRE> ... </PRE> or <TABLE> ... </TABLE>
# 	 OUTPUT_METHOD = LST to return a listing file.  The output is
#			wrapped in <PRE> ...</PRE> by this script, formfeeds are
#			translated to <HR>, and the result sent to the browser.
#	 OUTPUT_METHOD = IMAGE/type to return an inline image, output as
#        <img src="$sasfile.type">.  Type defaults to 'gif'

#	Might want to add others, if I can figure out how, e.g.,
#   OUTPUT_METHOD = FILE(name)

#	The script is also designed so that it can be run from the command
#	line for debugging, e.g.,
#		setenv DEBUG 1
#		./sascgi 'SASFILE=getlist.sas&LISTS=1&ITEMS=20'
#	The parameters DEBUG, SASFILE, TITLE, and OUTPUT_METHOD may all be
#	passed to this script via the form or the environment.

# Copyright 1996, Michael Friendly.  You are free to use and
# redistribute this script so long as this copyright statement
# remains intact.

#--------- Installation        ---------
# 1. Copy this file to your http/cgi-bin directory, make sure it is
#		executable.  Modify items in configuration section and after __END__ 
#     as required.  Make sure the first line of the script points to your
#     perl executable.
# 2. Create a directory somewhere for SAS files run by 'nobody' to
#		write it's files.  Make this directory world-writable (chmod +w).
# 3. You may want to add a line to your crontab.local to cleanup this
#		directory periodically. I use:
#10,30,50 * * * *  root /usr/local/bin/find /usr/local/etc/httpd/htdocs/tmp/ -cmin +10  -exec rm -f {} \;
#		which runs 3 times/hour to remove all files older than 10 minutes

#---------- Dependencies --------------
# This script uses the CGI.pm library, which must be installed in 
# /usr/local/lib/perl5 or equivalent.
# See:  http://www-genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html

require 5.000;	# This is a perl5 script
use CGI;
use CGI::Carp;			# redirect errors to server error log

#----------- Bugs / Limitations --------
# - Browsers which cache images may not reload the current result if the
#	script is run again.

#----------- To Do ---------------------
# - Allow for range/type checking of form inputs

#--------- Configuration items ---------

$SAS = '/usr/local/bin/sas';	   		# path to sas executable
$SAS = '/LocalApps/sas.app/sas';			# path to sas executable
$RM  = "/usr/local/bin/rm";

# location of pstogif (from the Latex2html distribution)
$PSTOGIF = '/usr/local/bin/pstogif';	# script for .ps to .gif conversion

$httmp = '/usr/local/etc/httpd/htdocs/tmp';   # where SAS file get created
$www_httmp = '/tmp';                   #this path, relative to server root

$saswork = '/tmp';                                  # saswork directory
$sasconfig = '/users/faculty/friendly/config.sas';  # path to config.sas
$sasopts = "-sasuser $saswork -config $sasconfig";
$sysver = 6.07;			            # version of SAS running on the server

# Locations of SAS files to be run by sascgi:
# Any file in @sas_dirs need not be explicitly listed in %file_paths

$www_dir1 = '/users/faculty/friendly/sasuser/www';
$www_dir2 = '/users/faculty/friendly/sasuser/pools';
@sas_dirs = ( $www_dir1, www_dir2 );

# Or, define associative list to translate sas filenames to absolute paths
%file_paths = (
#	'getlist.sas' => "$www_dir2/getlist.sas",
	'getlist.sas' => "/users/faculty/friendly/SCS/Online/paivio/getlist.sas",
	'wwwdens.sas' => "$www_dir2/wwwdens.sas",
	'wwwpoly.sas' => "$www_dir1/wwwpoly.sas",
	);

# SAS/GRAPH device drivers used to produce various types of images.
# (Since I'm running SAS 6.07, gif is produced from a .ps file)
%devices = (
#	'gif' => 'imggif',
	'gif' => 'nextclr',
	'ps'  => 'pscolor',
	);


# Set non-zero to copy the sasfile under a unique filename
$unique_filename = 1;

# For sasfile pathname translation, change this if your site
# uses something different for its user's home web directories.
# (Only relevant if you want to refer to SAS and/or configuration
# files in the form using ~user/path form.  

$PUBLIC_HTML = 'public_html';

# See the material following the __END__ for more user-configurable
# options.

#--------- End of Configuration items ---------

#####################################################
# From here to __END__ should not need to be changed
#####################################################
%VERBOTEN = ('SCRIPT'=>1,'REFERER'=>1,
	     'REMOTE_USER'=>1,'USER_AGENT'=>1,'REMOTE_HOST'=>1,
	     'SERVER'=>1,'SERVER_HOST'=>1,'ADMINISTRATOR'=>1,
	     'ESCAPE_HTML'=>1);

# Don't pass to SAS program
%MYPARMS = ( 'REQUIRE'=>1 );


$ENV{'PATH'}="/bin:/usr/bin:/usr/ucb";       # untaint $PATH

#-- Let's get started
$query = new CGI;


# Retrieve the name of the sasfile passed by the hidden field in the
# form.  Translate it to an absolute path.  

$sasfile = $query->param('SASFILE')
		|| $query->parma('_PROGRAM')
		|| $ENV{'SASFILE'};

$sasfile_path = &find_file($sasfile);

# Read our configuration files and store the token
# lookup table in "config"
($config,$forms) = &read_configuration($query);

$debug = $query->param('DEBUG') || $ENV{'DEBUG'} || 0;

$title = $query->param('TITLE')
#		|| $config->{TITLE}
		|| "SAS Results from $sasfile";

$output_method = $query->param('OUTPUT_METHOD') 
		|| $ENV{'OUTPUT_METHOD'}
		|| 'STDOUT';

# unbuffer output so that we can see it as it comes 
# out, rather than waiting for buffers to flush
$| = 1;

&print_HTTP_header($title);
&croak("Configuration error: Can't find SASFILE: $sasfile") 
	unless defined $sasfile_path;
&process_params;
&check_params;
exit if $errors;
&run_program;
&print_env if $debug > 1;
&print_tail;
exit;


# ----------------- subroutines ------------
sub print_HTTP_header {
    my($title) = @_;
#	print $query->header(-expires=>'+1m');
	print $query->header();
	print $query->start_html(-title=>"$title", 
		-author=>"$config->{AUTHOR_EMAIL}",
		-BGCOLOR=>"$config->{BGCOLOR}"), "\n";
}

sub process_params {
	print "<h1>$title</h1>\n";
	print "<h3>Query Options and Parameters</h3>\n<ol>\n"  if $debug;
	foreach $p ($query->param()) {
		next if $VERBOTEN{$p};	# certain parameters can't be set by the form
		$value = &process_user_input($query->param($p));
		print "<li>$p is $value\n" if $value && $debug;
		next unless $value;
		# the REQUIRE parm can be a space-separated list
		push (@require, split(' ',$value)) if $p =~ /REQUIRE/i;
		next if $MYPARMS{$p};
		$ENV{$p} = $value;
	}
	print "</ol><hr>\n" if $debug;

}


# Join multivalued parameters 
# (Stolen from L. Stein's mailmerge package)
sub process_user_input {
    my(@values) = @_;
    @values = grep ($_,@values);
    
    # This is a convenient place to escape any HTML characters
    # in the user's input, if present.
    if ($escape_html) {
	foreach (@values) {
	    $_ = &CGI::escapeHTML($_);
	}
    }
    return $values[0] unless @values > 1;
    if ($config->{MULTIVALUE_FORMAT} eq 'BRACES') {
	return "{" . join(",",@values) . "}";
    } elsif ($config->{MULTIVALUE_FORMAT} eq 'COMMAS') {
	return join(", ",@values);
    } else {
	return join(" ",@values);
	 }
}

sub check_params {
	# Check required parameters.  For now, just check that they've
	# been defined.  Add ability to do type/pattern checking

	return unless defined(@require);

	my($pattern);
	foreach $arg (@require) {
		($name, $pattern) = split('/', $arg, 2);
		if (!$ENV{$name}) {
			&whine("The $name parameter must be given a value.");
			$errors++;
			next;
		}
#		if (defined $pattern) {
#		}
	}
}

sub run_program {
   &croak("$Script: Specified SAS file '$sasfile_path' does not exist,"
	 	.  " or is not world-readable.") unless -r $sasfile_path;

#	Change to the $httmp directory.  It must be world-writable
	chdir($httmp);

	$sasfile =~ /^(\w+)\./;
	$base=$1;

#	Copy the $sasfile here under a unique name, so that multiple,
#	overlapping executions will not clash in producing identical log/lst 
#	files.  More importantly, for graphics, browsers will not cache.

	if ($unique_filename) {
		srand;
		$base .= $$;                          # process id
		$base .= ('a'..'z')[int(rand(25))];   # plus random letter
		
	#	Remove any previous listing/log files here.  Otherwise, we may get 
	#	permission errors when SAS tries to overwrite an existing file.
	#	unlink <$base.*>;		# unlink didn't work for some reason
		system ("$RM -f $base.*");
		system ("cp $sasfile_path $httmp/$base.sas");
		$sasfile_path = "$httmp/$base.sas";
	}
		
	print "<br>Running:\n<br>  $SAS $sasopts -sysin $sasfile_path<br>\n" if $debug;
	$!=0;

	$start_time = (times)[0];
	
	if ($output_method =~ /STDOUT/i) {
#		Capture all the output into an array.  Assume this won't overflow
#		memory.
#		We should avoid starting up a new shell for security, but everything
#		here is untainted.  
		print "Output via STDOUT\n" if $debug;

		@output = `$SAS $sasopts -sysin $sasfile_path`;
		$run_time = sprintf("\n<p>Run time was %.3f CPU seconds\n",
			  ((times)[0] - $start_time));
		$config->{RUN_TIME} = $run_time;
		$config->{HREF_SASLOG} = qq(<a href="$www_httmp/$base.log">$base.log</a>);
		&croak("$sasfile produced no results") unless @output;

		# Should check for 'ERROR:' in @output
		#	remove input record separator
		&print_output($config, $forms->{OUTPUT_FORM}, @output);
	}

	elsif ($output_method =~ /LST/i) {
		print "Output via LST\n" if $debug;

#		Assume the program will produce results in $base.lst in current dir
		system ("$SAS $sasopts -sysin $sasfile_path");
		$run_time = sprintf("\n<p>Run time was %.2f CPU seconds\n",
			  ((times)[0] - $start_time));
		$config->{RUN_TIME} = $run_time;
		$config->{HREF_SASLOG} = qq(<a href="$www_httmp/$base.log">$base.log</a>);
		&croak("$sasfile produced no results") unless -f "$base.lst";

		open (LST, "< $base.lst");
		@output = <LST>;			# slurp the whole thing in one bite
		close(LST);

		foreach (@output) {
			s/\f/<hr>/;			# ^L -> page separator
			s/</&lt;/;
			s/>/&gt;/;
		}
		@output = ( "<pre>\n", @output, "</pre>\n")
		&print_output($config, $forms->{OUTPUT_FORM}, @output);
	}

#	#### Graphic Output ####  This code is not very general
	elsif ($output_method =~ /IMAGE/i) {
		($dum, $image_type) = split('/', $output_method);
		$image_type =~ tr/A-Z/a-z/;
		$image_type ='gif' unless $image_type;
		$device = $devices{$image_type} || 'nextclr';
		print "Output via IMAGE, type: $image_type, driver: $device\n" if $debug;
		$sasopts .= " -device $device";
		$gext = ($device eq "nexteps") ? ".eps" : ".ps"; 

		# let SAS file know what filename to use for output
		$gsasfile = $base . $gext;		
		print "gsasfile : $gsasfile\n" if $debug;
		$ENV{'GSASFILE'} = $gsasfile;

		system ("$SAS $sasopts -sysin $sasfile_path");
		$run_time = sprintf("\n<p>Run time was %.2f CPU seconds\n",
			  ((times)[0] - $start_time));
		$config->{RUN_TIME} = $run_time;
		$config->{HREF_SASLOG} = qq(<a href="$www_httmp/$base.log">$base.log</a>);

		# assume the $sasfile produces an output file with same basename
		&croak("$sasfile produced no image") unless -f $gsasfile;

		if (($image_type =~ /gif/i) && $sysver < 6.11) {
			# use PSTOGIF to create gifs from .ps
			# WARNING: pstogif uses environment vars which can clash!!
			undef($ENV{'DEPTH'}) if $ENV{'DEPTH'};
			$ENV{'SILENT'} = 1 unless $debug;
			print "Running $PSTOGIF -out $base.gif $gsasfile >/dev/null\n" if $debug;
			system ("$PSTOGIF -out $base.gif $gsasfile >/dev/null");
			$gext = ".gif";
 		}		

		# possibly the file creates more than one image
		opendir(IMG, $httmp) || &croak("Couldnt open $httmp to look for images");
		@images = grep(/$base[0-9]*$gext/, readdir(IMG));
		print "Sending $#images images", join(" ",@images), "\n" if $debug;
		closedir(IMG);

		foreach $img (@images) {
			print "<p>Output image $img:<br>\n";
#			print qq(<img src="$www_httmp/$img">);
			push (@output, qq(<img src="$www_httmp/$img">));
		}
		&print_output($config, $forms->{OUTPUT_FORM}, @output);

	}
	
	else {
		&croak("$Script: Output method $output_method is not defined.");
	}
	# print "<br>Ran:\n<br>  $SAS $sasopts -sysin $sasfile_path<br>\n" if $debug;

#  Determine if the program wrote a .ERR file in the $httmp directory to
#  signal an error

	if (-f "$base.err") {
		open(ERR, "$base.err");
		chop($sas_rc = <ERR>);
		close(ERR);
	} 
	&croak("$Script: The propgram $sasfile ended abnormally -- $sas_rc")
		if $sas_rc;
}

sub print_tail {
	print $config->{RUN_TIME} if $config->{SHOW_RUN_TIME};
	print <<END_OF_ADDRESS;
<HR>
$config->{SASPOWEREDLOGO}<BR>
<ADDRESS>
$config->{AUTHOR}<BR>
$config->{ADDRESS}
</ADDRESS>
END_OF_ADDRESS
;

	print <<END_OF_PLUG;
This application was run by
<a href="$ScriptDocURL">$ScriptIcon $Script</a> (v. $Version)
by $ScriptAuthor
END_OF_PLUG
	;
	print $query->end_html, "\n";
}

# Substitute the @output array into the OUTPUT_FORM and print
sub print_output{
	my($config, $form, @output) = @_;
	
	$out = join("", @output);
	$config->{OUTPUT} = $out;
   $form = &do_substitutions($form,$config);
	
	print $form;

	
}

# Dump the query & environment variables -- for debugging
sub print_env {
	#	unclutter output for command-line debugging
	my(%ignore_env);
	for (qw(TERM TERMCAP MANPATH TEXFONTS TEXEDIT TEXINPUTS PERLLIB PERL5LIB
			NNTPSERVER MAILER POSTER VISUAL EDITOR DISPLAY)) {
		$ignore_env{$_} = 1;
	}
	
	print "<HR>\n";
	print "File: $sasfile -> $sasfile_path\n<br>";
	print "Title: $title\n<br>";
	print "CGI.pm Version: $CGI::VERSION\n<br>";
	print "<H3>Script Query Values</H3>\n", $query->dump, "\n";
		
	print "<H3>CGI Environment</H3>\n";
	print "<pre>\n";
	foreach $var (keys %ENV){
			print "$var = $ENV{$var}\n" unless $ignore_env{$var};
	}
	print "\n\n</pre>\n";

	print "<H3>SASCGI Configuration Info</H3>\n";
	print "<pre>\n";
	foreach $var (keys %$config){
			print "$var = $config->{$var}\n";
	}
	print "\n\n</pre>\n";
}

# -------- Find file -----------------
#  First look for an absolute file path, then for a ~user/path
#  then in defined $file_paths, then in defined @sas_dirs
 
sub find_file {
	my($file) = @_;
		
	return $file if ($file =~ m|^/| && -r $file);	# absolute path? 
   $file=~s@~([^/]+)@&getlogin($1)@e;              # ~name/path ?
	return $file if -r $file;
	
	if (defined $file_paths{$file}) {
		return $file_paths{$file} if -r $file_paths{$file};
	}

	foreach $dir (@sas_dirs) {
		return "$dir/$file" if -e "$dir/$file";
	}

	# if looking for config file, check in the same dir holding the sasfile
	if (defined($sasfile_path)) {
		return "$sasfile_path/$file" if -e "$sasfile_path/$file";
	}
	return undef;
}

####
# Get login account for ~name substitution
#
####
sub getlogin {
    return (getpwnam($_[0]))[7] . "/$PUBLIC_HTML";
}

# -------- Parse configuration information -------
# Pass the routine a filehandle open to the configuration
# file
sub read_configuration {
    my($query) = @_;
    my($config) = {};
    my($forms) = {};
    my($user_config_file);

    &config(DATA,$config,$forms);		# read our built-in defaults

	$config_param = $query->param('CONFIG');
	
	$user_config_file = &find_file($config_param);
	
    if ($user_config_file) {
	open (USER_CONFIG,"$user_config_file") || &croak("$user_config_file: $!");
	&config(USER_CONFIG,$config,$forms);
	close(USER_CONFIG);
    }

    return ($config,$forms);
}

# Read an individual configuration file.
sub config {
    my($filehandle,$config,$forms)=@_;
    my($tag,$value,$old);

    &fill_in_predefines($config);
    while (<$filehandle>) {
	chomp;
	next if /^#/;
	next unless ($tag,$value) = /(^\w+)\s*=\s*(.*)/;
	if ($tag=~/OUTPUT_FORM|INPUT_FORM/) {
	    ($old,$/)=($/,"\n.\n"); # look for a lonely dot
	    chomp($forms->{$tag}=<$filehandle>);
	    $forms->{$tag} .= "\n"; # add back a newline
	    $/=$old;
	} else {
	    $config->{$tag} = &do_substitutions($value,$config);
	}
    }

}

# Fill in a few of the special predefined tags.
sub fill_in_predefines {
    my $config = shift;
	 $config->{SASFILE} = $sasfile;
    $config->{DATE}=localtime;
    $config->{SCRIPT}=$query->script_name;
    $config->{REFERER}=$query->referer;
    $config->{REMOTE_USER}=$ENV{HTTP_FROM} ||
		$query->remote_ident || $query->remote_user;
    $config->{USER_AGENT}=$query->user_agent;
    $config->{REMOTE_HOST}=$query->remote_host;
    my($name,$junk,$junk,$junk,$junk,$junk,$gcos) = getpwuid($<);
    $config->{SERVER} = "$name\@" . $query->server_name . " ($gcos)";
    $config->{SERVER_HOST} = $query->server_name;
    $config->{ADMINISTRATOR} = $ENV{SERVER_ADMIN};
}

# Do the variable substitutions.
sub do_substitutions {
    my($scalar,$config) = @_;
    my($key);
    my(@keys) = $scalar=~/\@(\w+)\@/g;

    # Note that we use the unoptimized s/// form here for
    # security reasons -- check the performance!
    foreach $key (@keys) {
	$scalar=~s/\@$key\@/$config->{$key}/g;
    }
    return $scalar;
}


# -------------- error reporting utility ---------------
sub croak {
    my($msg) = @_;
    print "<P><STRONG>An error occurred while processing this form:</STRONG>\n";
    print "<P>$msg\n";
	 &print_tail;
    die $msg;
}

sub whine {
    my($msg) = @_;
    print "<P>Input error: <STRONG>$msg</STRONG>\n";
}

__END__

###########################################################
# More user-configurable defaults.  These can (and are
# intended to) be overridden by values provided in a
# configuration file whose address is passed to sascgi
# in the CONFIG field:
#  	<input type="hidden" name="CONFIG" value="getlist.cfg">
#     
###########################################################

###
# You'll want to adjust these for your site
###

# The title for the output page, unless defined in the input form.
TITLE=SAS Results from @SASFILE@

# Author and address are printed at the bottom of the page.  These should be all on
# one line.  If any of these are defined as empty, they will not appear in the
# output.

AUTHOR_EMAIL=friendly\@yorku.ca

AUTHOR=<A HREF="http://www.math.yorku.ca/SCS/friendly.html">Michael Friendly</A> Email: <a href="mailto:@AUTHOR_EMAIL@"> (@AUTHOR_EMAIL@)</a>

ADDRESS=<A HREF="http://www.math.yorku.ca/SCS/SCS.html">Statistical Consulting Service, York University</A>

# Background color of output form.  Omit if you don't want to set background color
BGCOLOR=white

# Get a local copy of the SAS Powered Logo and replace this URL with your
# local address.  Get the image file from SAS Institute at
#    http://www2.sas.com/dispatcher/index.html
SASPOWEREDLOGO = <IMG width=92 height=32 SRC="http://www.math.yorku.ca/SCS/icons/saslstat.gif">

# Set this non-zero to display the running time in the output
SHOW_RUN_TIME=1

# MULTIVALUE_FORMAT determines how multivalue parameters from the input form
# are passed in the environment to the SAS program
# Set this field to BRACES to pass multivalued parameters as "{a,b,c}".
# Set to COMMAS to show multivalued parameters as "a, b, c".
# Set to SPACES to pass as "a b c"
MULTIVALUE_FORMAT=BRACES


############
# This defines the output form -- the way the output is returned to the browser.
# SAS output is interpolated back into what is returned to the browser in the
# place of '@OUTPUT@'.  A link to the SASLOG is included if the OUTPUT_FORM
# contains @HREF_SASLOG@.
# Everything from OUTPUT_FORM=
# to the dot (.) at the very bottom is the form.

OUTPUT_FORM=
The following output was produced:
<br>
<center>
@OUTPUT@
</center>
View the saslog: @HREF_SASLOG@
.