#!/usr/bin/perl

# ezpauth.pl
# (c) 1999-2000 Useful Utilities
# http://www.usefulutilities.com

# These are a set of core routines for building external authentication
# scripts for use with EZproxy

# Revised 8/26/99 to correct problems in AuthIII with wrong extraction of
# expiration date

# Revised 11/12/99 to change last name comparison in AuthIII to deal with
# last names containing spaces (eg. Du Bois)

# Revised 11/23/99 to correct minor problem with default port number

use Socket;
use Time::Local;

sub Debug {
  return if $debugFile eq "";
  if ($debugOpen != 1) {
    open(DEBUG, ">>$debugFile") || return;
    $debugOpen = 1;
  }
  flock(DEBUG, LOCK_EX);
  seek(DEBUG, 0, 2);
  print DEBUG $_[0];
  flock(DEBUG, LOCK_UN);
}
  
sub Down
{
  Debug("$_[0]\n");
  print "Content-type: text/html\n\n";
  print $_[0], "\n";
  exit(1);
}

sub FormEncode
{
  my $temp = $_[0];

  $temp =~ s/([&'"])/sprintf("&#%d;",ord($1))/ge;
  return $temp;
}

sub URLEncode
{
  my $temp = $_[0];

  $temp =~ s/([^A-Za-z0-9])/sprintf("%%%2X", ord($1))/eg;
  $temp =~ s/%20/+/g;
  return $temp;
}

sub ParseFields
{
  my $in, $fieldval, $field, $val, $count;

  %in = ();
  if ($ENV{"REQUEST_METHOD"} eq "GET") {
# url= is extracted straight from the QUERY_STRING on a GET to preserve
# all the characters that follow url=.  EZproxy expects this to be handled
# in this manner
    if ($ENV{"QUERY_STRING"} =~ s/&?url=(.*)$//) {
      $in{"url"} = $1;
    } 
    $in = $ENV{"QUERY_STRING"};
  } elsif ($ENV{"REQUEST_METHOD"} eq "POST") {
# In a POST, no special processing of URL is required
    read(STDIN, $in, $ENV{"CONTENT_LENGTH"});
  } else {
    return 0;
  }

  $count = 0;
  foreach $fieldval (split(/&/, $in)) {
    $fieldval =~ s/\+/ /g;
    ($field, $val) = split(/=/, $fieldval, 2);
    $val =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
    # Remove inresult characters
    $val =~ s/[^!-~]//g;
    $in{$field} = $val;
    $count++;
  }

  if (defined $in{"url"}) { $ezpurl = $in{"url"} };

  return $count;
}

sub ParseHostPort
{
  if ($_[0] =~ /^(.*):(\d+)$/) {
    return ($1, $2);
  }
  return @_;
}

sub MakeConnection
{
  my $fh, $host, $port, $proto, $proto, $oldfh;

  ($fh, $host, $port) = @_;

  if ($host =~ s/:(\d+)$//) {
    $port = $1;
  }

  $proto = getprotobyname('tcp');

  $iaddr = inet_aton($host) || Down("Unable to lookup host $host: $!");
  $paddr = sockaddr_in($port, $iaddr);
  socket($fh, PF_INET, SOCK_STREAM, $proto) ||
    Down("Unable to create socket: $!");
  connect($fh, $paddr) || Down("Unable to connect to $host:$port: $!");

  $oldfh = select($fh);
  $| = 1;
  select($oldfh);
}

sub StartSession
{
  my $query;

  $query = "?user=" . URLEncode($ezpuser) . "&pass=" . URLEncode($ezppass);

  # If the calling script has set $ezploguser, pass this value to EZproxy
  # to log to the ezproxy.log file.  Note that your ezproxy.cfg must also
  # contain "O LOGUSER" to enable this feature.
  if ($ezploguser ne "") { $query .= "&loguser=" . URLEncode($ezploguser); }

  # We don't URLEncode the query since EZproxy expects it to be literal
  if ($ezpurl ne "") { $query .= "&url=$ezpurl"; }

  MakeConnection(EZPROXY, $ezphost, $ezpport);
  
  print EZPROXY "GET /login$query HTTP/1.0\n\n";
  $skip = <EZPROXY>;
  print while <EZPROXY>;
  close(EZPROXY);
}

# AuthPOP return 0 if authenticated, 1 if not
sub AuthPOP
{
  my $host, $user, $pass, $result, $state;

  ($host, $user, $pass) = @_;

  MakeConnection(POP, $host, 110);

  $result = 1;

  for ($state = 0; <POP>; $state++) {
    last unless /^\+OK/;
    if ($state == 0) {
      print POP "USER $user\n";
    } elsif ($state == 1) {
      print POP "PASS $pass\n";
    } else {
      $result = 0;
      last;
    }
  }

  print POP "QUIT\n";
  close(POP);

  return $result;
}

# AuthIMAP return 0 if authenticated, 1 if not
sub AuthIMAP
{
  my $host, $user, $pass, $result, $state;

  ($host, $user, $pass) = @_;

  MakeConnection(IMAP, $host, 143);

  $result = 1;

  for ($state = 0; <IMAP>; $state++) {
    chop;
    last unless /^. OK/;
    if ($state == 0) {
      print IMAP "1 LOGIN $user $pass\n";
    } else {
      $result = 0;
      last;
    }
  }
  print IMAP "2 LOGOUT\n";
  close(IMAP);

  return $result;
}

# AuthFTP return 0 if authenticated, 1 if not
sub AuthFTP
{
  my $host, $user, $pass, $result, $state;

  ($host, $user, $pass) = @_;

  MakeConnection(FTP, $host, 21);

  $result = 1;

  for ($state = 0; <FTP>; $state++) {
    chop;
    if ($state == 0) {
      next if /^120/;
      last unless /^220/;
      print FTP "USER $user\n";
    } elsif ($state == 1) {
      last unless /^331/;
      print FTP "PASS $pass\n";
    } else {
      last unless /^230/;
      $result = 0;
      last;
    }
  }
  print FTP "QUIT\n";
  close(FTP);

  return $result;
}

# AuthIII return 0 if authenticated, 1 if not found, 2 if expired
sub AuthIII
{
  my $host, $user, $pass, $result, $expire, $mon, $day, $year, $last, $part,
     $type, $types, $typeresult, $nameresult, $idresult;

  ($host, $user, $pass, $types) = @_;

  $types = ":$types:";

  Debug("Attempt III for $user\n");

  MakeConnection(III, $host, 4500);

  print III "GET /PATRONAPI/$user/dump HTTP/1.0\n\n";

  $idresult = 1;
  $nameresult = 1;
  $typeresult = ($types eq "::" ? 0 : 3);

  while (<III>) {
    Debug($_);
    s/\r?\n?$//;
    if (/^EXP DATE\[p43\]=(\d{1,2})-(\d{1,2})-(\d{2,4})<BR>/) {
      ($mon, $day, $year) = ($1, $2, $3);
      if ($year >= 1900) { $year -= 1900 };
# We've extracted the month, day and year, so now timelocal is used
# to change that to a numeric time comparable to the time() function
# For timelocal, we must subtract 1 from the month
      $expire = timelocal(0, 0, 0, $day, $mon - 1, $year);

# Return 0 on unexpired number, 2 if found but expired
      $idresult = time() < $expire ? 0 : 2;
    }

    if (/P TYPE\[p47\]=(.+)<BR>$/) {
      $type = ":$1:";
      if ($type ne "::" && $types =~ /$type/) {
        $typeresult = 0;
      }
    }
      
    if (/^PATRN NAME\[pn\]=(.+)<BR>$/) {
      $last = $1;
      # Remove everything after first comma
      $last =~ s/,.*//;
      # Remove all spaces
      $last =~ s/\s//g;
      $last =~ tr/a-z/A-Z/;
      $pass =~ tr/a-z/A-Z/;
      if ($last eq $pass) {
        $nameresult = 0;
      }
    }
  }

  # If the name matched, return the date check result, otherwise return
  # the "not found" result
  if ($nameresult == 0) {
    if ($idresult == 0) {
      $result = $typeresult;
    } else {
      $result = $idresult;
    }
  } else {
    $result = 1;
  } 
  close(III);

  Debug("Result for $user is $result\n");
  return $result;
}

$action = $0;
$action =~ s/^.*[\/\\]//g;

$ezpport = 2048;

$| = 1;

1;