$header

#!/usr/local/bin/perl

# Author:
# Adam Griff - CU Boulder and Lehigh U.
# 2/95
# with some help from MIT and Birmingham
# cgi-lib.pl

# Goal:
# program to make using forms with the POST or GET action 
# POST is recommended over GET which has a size limitation
# Create an associative array and for multiples
# seperate the entries with \0

# Global Variables:
# @cgipairs is a global array created by form_response
# $FORM is a global associative array created by form_response

# Example script:
#  !/usr/local/bin/perl
#  local($program) = "form-test.pl";
#  local($title) = "Test the Response from a Form";
#  local($author) = "Adam J. Griff, &#099;omputer&#064;&#103;riff&#109;onster.<!-- ajg  protection  -->com";
#  require '/path/cgi-parse.pl';   
#  &form_response;
#  print &html_header($title);
#  print &html_from_assoc_array(%FORM,$title);
#  print &html_trailer($author,$program);

# Example of dmb
#  local ($dbmFile)="/path/mail-code";
#  local ($alias)="administrator";
#  local ($to)="&#099;omputer&#064;&#103;riff&#109;onster.<!-- ajg  protection  -->com";
#  local ($real_name)="Adam Griff";
#  local ($comment)="This is for the Griff Admin";
#  &add_user($dbmFile,$alias,$to,$real_name,$comment);
#  ($to,$real_name,$comment)=&lookup_user($dbmFile,$alias);
#  print &html_header($title);
#  print &html_from_users($dbmFile,"the title");
#  print &html_trailer($author,$program);
#  &remove_user($dbmFile,$alias);

# number of seconds to wait for a lock
$lockWait = 5;

#change the umask
umask 006;

# the title is passed as a parameter
# returns the text in html format as a string
sub html_header {
  local($title) = @_;
  local($output);

  # Print out a content-type for HTTP/1.0 compatibility
  $output = "Content-type: text/html\n\n";

  # Print a title and initial heading
  $output .= "<HTML>\n<Head><Title>$title</Title></Head>\n<Body>\n";
  return $output;
}

# generates html trailer message and returns is as a string
# the author and program are passed as a parameters
sub html_trailer {
  local($author,$program) = @_;
  local($output);
  local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst)
      = localtime(time);
  local($mname) = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul",
		   "Aug", "Sep", "Oct", "Nov", "Dec")[$mon];
  local($dname) = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri",
		   "Sat")[$wday]; 
  $output = "<p>\n<hr>\nGenerated from <em>$program</em> on ";
  $output .= sprintf("$hour:%02d:%02d MT on $dname $mday $mname 19$year.<br>\n", $min,$sec);
  $output .= "<address>$author</address><br>\n</Body></HTML>\n";
  return $output;
}

# Get the input from the form on STDIN for POST or
# from the QUERY_STRING for the GET.
# Creat an associative array and an array using the global
# variables @FORM and @cgipairs
sub form_response {
  local($buffer,$pair,$name,$value);
  
  if (defined $ENV{'REQUEST_METHOD'} && defined $ENV{'CONTENT_LENGTH'} && $ENV{'REQUEST_METHOD'} eq "POST") {
    read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
  } elsif (defined $ENV{'REQUEST_METHOD'} && defined $ENV{'QUERY_STRING'} &&$ENV{'REQUEST_METHOD'} eq "GET" ) {
    $buffer = $ENV{'QUERY_STRING'};
  } else { $buffer=""; }

  # Split the name-value pairs on char '&'
  @cgipairs = split(/&/, $buffer);

  # create an associative array
  foreach $pair (@cgipairs)    {
    ($name, $value) = split(/=/, $pair);

    # Un-Webify plus signs to spaces and %-encoding in the values
    $value =~ tr/+/ /;
    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

    # Stop people from using subshells to execute commands
    # Not a big deal when using sendmail, but very important
    # when using UCB mail (aka mbbailx).
    # $value =~ s/~!/ ~!/g; 

    # Uncomment for debugging purposes
    # print "$name = $value&";

    # \0 is the multiple separator
    if (defined $FORM{$name}) {
      $FORM{$name} .= "\0";
      $FORM{$name} .= $value;
    } else {
      $FORM{$name} = $value;
    }
  }
}

# lock a file before using it.
sub lock_file {
  local($logFile)=@_;
  local($lockCount) = 0;
  $lock_file_err="";
  while (-f "$logFile.lock") { 
    if ($lockCount > $lockWait) {
      $lock_file_err="<H2><blink>File was locked.</blink></H2><p>\n";
      return 0; #give up
    }
    sleep 1; 
    $lockCount++;
  }
  if (! open(LOCK,">$logFile.lock")) {
    $lock_file_err="<H2><blink>Can't open lock file.</blink></H2><p>\n";
    return 0;
  }
  close(LOCK);
  return 1;
}

# unlock a file after use
sub unlock_file {
  local($logFile)=@_;
  unlink("$logFile.lock");
}

# converts an associative array passed as a paramter
# to an html format. Also handles multiple values seperated by \0
# also pass a header optional
sub html_from_assoc_array {
  local(%FORM,$header) = @_;
  local($output,$item,$out,$i,@out);
  $output ="<hr size=5>\n";
  ($output .= "<H1>$header</H1>\n") if $header;
  $output .= "<ul>\n";
  foreach $item(sort keys %FORM) {
    # check if this is a multiple item
    if (index(($out=$FORM{$item}),"\0") != -1) {
      $output .= "<li><pre> $item\n";
      # create an array on the multiple items
      @out = split(/\0/,$out);
      foreach $i (0 .. $#out) {
	$output .= "  [$i] = $out[$i] \n";
      }
      $output .= "</pre>\n";
    } else {
      $output .= "<li><pre> $item = $out</pre>\n";
    }
  }
  $output .= "</ul>\n<hr size=5>\n";
  return $output;
}			       

# add an entry to the dbmfile
sub add_user {
  local($dbmFile,$alias,$to,$real_name,$comment) = @_;
  local(%USERS);
  if (&lock_file($dbmFile) == 1) {
    dbmopen(%USERS,"$dbmFile",0666);
    $USERS{$alias}=join("\0",$to,$real_name,$comment);
    dbmclose(%USERS);
    &unlock_file($dbmFile);
    return 1;
  }
  return 0;
}

# generate html for all users in the dbmfile
sub html_from_users {
  local($dbmFile,$header) = @_;
  local($output,$item,$alias,$to,$real_name,$comment);
  local(%USERS);
  if (&lock_file($dbmFile) == 1) {
    dbmopen(%USERS,"$dbmFile",0666);
    $output ="<hr size=5>\n";
    ($output .= "<H1>$header</H1>\n") if $header;
    $output .= "<ul>\n";
    foreach $item(sort keys %USERS) {
      $out=$USERS{$item};	
      $output .= "<li><pre> $item =";
      @out = split(/\0/,$out);
      foreach $i (0 .. $#out) {
	$output .= "| $out[$i]";
      }
      $output .= "</pre>\n";
    }
    $output .= "</ul>\n<hr size=5>\n";
    dbmclose(%USERS);
    &unlock_file($dbmFile);
  } else {
    $output = $lock_file_err;
  }
  return $output;
}

# remove an element from the dbmfile
# return 1 if deleted, 0 if not found, -1 if lock_file_err
sub remove_user {
  local($dbmFile,$alias) = @_;
  local(%USERS,$removed);
  if (&lock_file($dbmFile) == 1) {
    dbmopen(%USERS,"$dbmFile",0666);
    if (defined $USERS{$alias}) {
      delete $USERS{$alias};
      $removed=1;
    } else {
      $removed=0;
    }
    dbmclose(%USERS);
    &unlock_file($dbmFile);
  } else {
    $removed=-1;
  }

  return $removed;
}

# lookup an element in the dbmfile
sub lookup_user {
  local($dbmFile,$alias) = @_;
  local(%USERS,@user);
  if (&lock_file($dbmFile) == 1) {
    dbmopen(%USERS,"$dbmFile",0666);
    if (defined $USERS{$alias}) {
      @user = split(/\0/,$USERS{$alias});
    }
    dbmclose(%USERS);
    &unlock_file($dbmFile);
  }
  return @user;
}

# returns 1 if correct 0 if not
sub check_passwd {
  local($passwdFile,$login,$passwd) = @_;
  local($answer);

  (return 0) if (!($login) || !($passwdFile) || !($passwd));

  open(CHECK, "/home/lampur/griff/WWW/bin/htadm -check $passwdFile $login $passwd 2>&1|");
  $answer = <CHECK>;
  close (CHECK);
  chop($answer);
  (return 1) if ($answer eq "Correct");
  return 0;
}

1;				#return true for the library