# CGIAuthHandler.pm # ----------------- # # A set of functions for doing username based authentication in a stupidly # restrictive safeperl environment # # Will normally be included inline in SafePerl scripts # # Works by checking an Apache password file for usernames and passwords # Initially sends the user a form to enter their credentials # These are checked against the file # If correct, a cookie is sent back to the browser, which contains the # username and a hash of the (hashed) password and something else (normally # the date). We have to use the hashed password, so we can verify the # cookie's value every time (by pulling the hashed password from the # file, and building our own copy of what their cookie ought to look like) # # To change how the login form looks, see the very bottom of the file # # This module is licensed under the GPL # # Nick Burch # v0.1 15/10/2003 require Exporter; @ISA = qw(Exporter); @EXPORT_OK = qw( &CGIBarf &checkUser &requestUser ); # Where out Apache password file lives my $pwdfile = ".htpasswd"; ######################## stuff for testing ######################## # Handy for debugging - die with a plain text header sub CGIBarf { my $text = shift; print "content-type: text/html\n\n"; print "An error occured\n"; print "

An error has occured

\n"; print "

$text

\n"; print "\n"; die($text); } # Not used # Handy guide for how to trigger the browser to ask for a password # Pity Apache won't show us the header you get back... sub requestUser { print "Status: 401 Authentication required\n"; print "Content-type: text/plain\n"; # print "WWW-Authenticate: Basic realm=\"Please enter your club login information\"\n"; print "WWW-Authenticate: Basic realm=\"testing\"\n"; print "\n"; print "Access to this resource requires authentication\n"; exit 401; } ##################### main section begins ####################### # Checks to see if a supplied username and password are correct # Returns the crypt'd password if correct, 0 if not sub checkUser { my ($user,$passwd) = @_; my ($slt,$cpw) = &fetchPass($user); unless($slt) { return 0; } my $cpass = crypt($passwd,$slt); if($cpass eq $cpw) { return $cpw; } else { return 0; } return 0; } # Looks through the password file for a user # Will return their password + salt if found, otherwise returns undef sub fetchPass { my $user = shift; open(PF,"<$pwdfile") or CGIBarf("Unable to load password file"); while() { chomp; my ($un,$cpw) = split(/\:/); if($un eq $user) { close(PF); my ($slt) = ($cpw =~ /^(\w\w)/); return ($slt,$cpw); } } close(PF); return undef; } # Sets the login cookie # Format is {username}-{hash} # Where hash is a crypt hash of the hashed password and today's date sub setCookie { my $user = shift; my $cpass = shift; my @time = gmtime(); # 3=day,4=mon my $tohash = $cpass."-".$time[3]."-".$time[4]; my $hash = crypt($tohash,$time[3]); $hash =~ s/\./\%2E/g; my $cookiestr = $user.'%2D'.$hash; print "Set-Cookie: poolbook=\"$cookiestr\"\n"; ## print "content-type: text/plain\n\n"; ## print $tohash."\n"; ## print "$user - $cpass\n"; ## print $cookiestr."\n"; ## exit; } # Checks the login cookie sub checkForCookie { foreach( split(/; /, $ENV{'HTTP_COOKIE'}) ) { my ($cookie,$value) = split(/\=/); if($cookie eq "poolbook") { $value =~ s/\"//g; my ($user,$hash) = ($value =~ /^(.*?)\%2D(.*)$/); $hash =~ s/\%2E/\./g; my @hashpw = &fetchPass($user); unless(@hashpw) { return 0; } my @time = gmtime(); # 3=day,4=mon my $tohash = $hashpw[1]."-".$time[3]."-".$time[4]; my $pwhash = crypt($tohash,$time[3]); if($pwhash eq $hash) { return $user; } return 0; } } return 0; } # If a form was submitted, check the username # If a cookie exists, check that # Otherwise, give the login form sub checkForUser { # Do they have a cookie? if( $ENV{'HTTP_COOKIE'} ) { my $user = &checkForCookie(); if($user) { return $user; } } # How about sending in a form? my $invalid = 0; if(my $ft = <>) { chomp($ft); my @args = split(/\&/,$ft); my $user; my $pass; my $a; foreach $a (@args) { $a =~ s/\+/\ /g; if($a =~ /^username=([\w\s]+)$/) { $user = $1; } if($a =~ /^password=(\w+)$/) { $pass = $1; } } if($user && $pass) { my $worked = &checkUser($user,$pass); if($worked) { &setCookie($user,$worked); return $user; } } $invalid = 1; } # If we get here, no valid credentials found print << "EOT"; Status: 401 Authentication required content-type: text/html Authentication Required

Authentication Required

EOT if($invalid) { print "

Invalid Login

\n"; } print << "EOT";

Username:

Password:

EOT exit; } 1;