#!/usr/bin/perl

#  Secure Cross Host Authentication System Login Token Granter
#  Copyright (C) 2000 Brian Ristuccia <brianr@osiris.978.org>
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or   
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of 
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  
#  GNU General Public License for more details.
# 
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software  
#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.    
# 

use MIME::Base64;

package dbmmanage;
#                               -ldb    -lndbm    -lgdbm
BEGIN { @AnyDBM_File::ISA = qw(DB_File NDBM_File GDBM_File) }
#use strict;
use Fcntl;
use AnyDBM_File ();
my %DB = ();


use CGI;
use MIME::Base64;
use Digest::SHA1; 
$|=1;

$query = new CGI;

$url = $query->param("url");
#print $query->header;
#print $query->start_html("Session PW Util");

$url =~ m"^http(s)?://([^/]+)(/.*)$";

$secure=$1;
$host=$2;
$path=$3;
$hash="oncrack";

# nuke any shell metacharacters
$host =~ s/['`"!\$]/_/sg;

# Get a good secret from /dev/random (nasty hack)
$password = Digest::SHA1::sha1_hex(`dd if=/dev/random bs=8 count=1`);
chomp $password;

$hash = "{SHA}" . Digest::SHA1::sha1_base64($password) . "=";
chomp $hash; 
#print "<P>" ; system("dbmmanage authdb/" . $host . " delete " . $ENV{'REMOTE_USER'});
#print "<P>" ; system("dbmmanage authdb/" . $host . " add " . $ENV{'REMOTE_USER'} . " " . $hash);

$file="authdb/" . $host;
tie %DB, "AnyDBM_File", $file, O_RDWR|O_CREAT, 0644 || die "Can't tie $file: $!";
$DB{$ENV{'REMOTE_USER'}}=$hash;
untie %DB;

$cookie = $ENV{REMOTE_USER} . ":$password"; #=~ s/(.)/sprintf("%%%02x",ord($1))/gei;

#print "Content-Type: text/html\n\n";
#print "<P>Host: $host<P>Path: $path<P>Password: $password<P>Hash: $hash<P>Cookie: $cookie";
print "Location: https://$host/nph-401.cgi?" . $cookie . "," . $url . "\n\n"; 
print STDERR "lin-Location: https://$host/nph-401.cgi?" . $cookie . "," . $url . "\n\n";