File Coverage

blib/lib/Digest/UserSID.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package Digest::UserSID;
require 5.001;
##############################################################################
# $Id: UserSID.pm,v 1.5 2001/03/21 17:32:11 unrzc9 Exp $          #
#
# See the bottom of this file for the POD documentation.  Search for the
# string '=head'.
# You can run this file through either pod2man or pod2html to produce pretty
# documentation in manual or html file format (these utilities are part of the
# Perl 5 distribution).
#
# Copyright 1999-2001 Wolfgang Wiese.  All rights reserved.
# It may be used and modified freely, but I do request that this copyright
# notice remain attached to the file.  You may modify this module as you
# wish, but if you redistribute a modified version, please attach a note
# listing the modifications you have made.
#
##############################################################################
# Last Modified on:	$Date: 2001/03/21 17:32:11 $
# By:			$Author: unrzc9 $
# Version:		$Revision: 1.5 $
##############################################################################
use strict;
use Digest::SHA1  qw(sha1 sha1_hex sha1_base64);

BEGIN {
    use Exporter   ();
    use vars       qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
    $VERSION = do { my @r = (q$Revision: 1.5 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
    $UserSID::VERSION = '$Id: UserSID.pm,v 1.5 2001/03/21 17:32:11 unrzc9 Exp $';
    @ISA         = qw(Exporter);
    @EXPORT      = qw(removewebsid getuserbysid makewebsid checkwebsid USID_check USID_add USID_update
                      read new create remove update);
    %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
    @EXPORT_OK   = qw();
}
use vars      @EXPORT_OK;


$UserSID::digest		= "hex";
	# Could be: binary, hex, base64. See the manual of Digest::SHA1 for more.
$UserSID::FILE			= "/tmp/sid";
	# Name for the dbm-file in which username, sid and time will be stored
$UserSID::MAXSECONDS		= 60*30;
	# Sets the time how long the sid is valid
$UserSID::CHECKTIMEONLY		 = 1;
	# If this is unlike 0 the routine 'checkwebsid' will check only
	# for the valid timerange but not of the userclient is valid.
	# Additionally in 'makewebsid' the used variables for encryption
	# dont use the typical environment-variables that are used to determine
	# the client.
##############################################################################
# Exported Subroutines
##############################################################################
sub removewebsid {
  my $name = shift;
  my $sha = shift;
  my $file = shift || $UserSID::FILE;
  my $maxseconds = shift || $UserSID::MAXSECONDS;

  if ((not $name) || (not $sha)) {
    return 0;
  }
  if (not %UserSID::DATA) {
    &LoadSIDData($file);
  }

  if ($UserSID::DATA{$name}) {
    delete $UserSID::DATA{$name};
    return &SaveSIDData($file);
  } else {
    return 0;
  }

}
##############################################################################
sub getuserbysid {
  my $code = shift;
  my $file = shift || $UserSID::FILE;
  my $key;
  my ($checksha, $checktime);
  my $found;

  if (not $code) {
    return;
  }
  if (not %UserSID::DATA) {
    &LoadSIDData($file);
  }
  foreach $key (keys %UserSID::DATA) {
    ($checksha, $checktime) = split(/\t/,$UserSID::DATA{$key},2);
    if ($checksha eq $code) {
      $found = $key;
      last;
    }
  }
  return $found;
}
##############################################################################
sub makewebsid {
  my $name = shift;
  my $code;
  my $ip;

  if (not $name) {
    return;
  }
  if ($UserSID::CHECKTIMEONLY) {
    $ip      = $ENV{'HTTP_X_FORWARDED_FROM'} || $ENV{'REMOTE_ADDR'} || $ENV{'REMOTE_HOST'};
    $code = $name.$ip;
  } else {
    my $referer = &GetSecondaryDN($ENV{'SERVER_NAME'});
    my $agent   = $ENV{'HTTP_USER_AGENT'};
    $ip      = $ENV{'HTTP_X_FORWARDED_FROM'} || $ENV{'REMOTE_ADDR'} || $ENV{'REMOTE_HOST'};
    $code =  $referer.$agent.$ip;
  }

  if (not $code) {
    $code = $<;
  }
  return &USID_add($name,$code);
}
##############################################################################
sub checkwebsid {
  my $name = shift;
  my $pass = shift;

  my $res = &USID_check($name,$pass);

  if (not $res) {
    return 0;
  }
  if ($UserSID::CHECKTIMEONLY) {
    return 1;
  }


  my $referer = &GetSecondaryDN($ENV{'HTTP_REFERER'});
  my $agent   = $ENV{'HTTP_USER_AGENT'};
  my $ip      = $ENV{'HTTP_X_FORWARDED_FROM'} || $ENV{'REMOTE_ADDR'} || $ENV{'REMOTE_HOST'};
  my $code =  $referer.$agent.$ip;
  if (not $code) {
    $code = $<;
  }
  $code = &CreateKey($code);

  if ($code eq $pass) {
    return 1;
  } else {
    return 0;
  }
}
##############################################################################
sub USID_add {
  my $name = shift;
  my $string = shift;
  my $file = shift || $UserSID::FILE;

  if ((not $name) || (not $string)) {
    return 0;
  }

  my $sid = new Digest::UserSID($file);
  my $res = $sid->create($name,$string);
  if ($res) {
    return $sid->{'sha'};
  } else {
    return 0;
  }
}
##############################################################################
sub USID_check {
  my $name = shift;
  my $sha = shift;
  my $file = shift || $UserSID::FILE;
  my $maxseconds = shift || $UserSID::MAXSECONDS;

  if ((not $name) || (not $sha)) {
    return 0;
  }
  if (not %UserSID::DATA) {
    &LoadSIDData($file);
  }
  if ($UserSID::DATA{$name}) {
    my ($checksha, $checktime) = split(/\t/,$UserSID::DATA{$name},2);
    if ($checksha eq $sha) {
      my $nowtime = time;
      if (($nowtime-$checktime) > $maxseconds) {
        delete $UserSID::DATA{$name};
        &SaveSIDData($file);
        return 0;
      } else {
        return 1;
      }
    } else {
      return 0;
    }
  } else {
    return 0;
  }
}
##############################################################################
sub USID_update {
  my $name = shift;
  my $sha = shift;
  my $file = shift || $UserSID::FILE;
  my $maxseconds = shift || $UserSID::MAXSECONDS;

  if ((not $name) || (not $sha)) {
    return 0;
  }
  if (not %UserSID::DATA) {
    &LoadSIDData($file);
  }
  if ($UserSID::DATA{$name}) {
    my ($checksha, $checktime) = split(/\t/,$UserSID::DATA{$name},2);
    if ($checksha eq $sha) {
      $checktime = time;
      $UserSID::DATA{$name} = "$checksha\t$checktime";
      return &SaveSIDData($file);
    } else {
      return 0;
    }
  } else {
    return 0;
  }
}
##############################################################################
sub read {
  my $sid = shift;
  my $user = shift;
  my $file = shift || $UserSID::FILE;

  if ((not $sid) || (not $user)) {
    return 0;
  }
  if (not %UserSID::DATA) {
    &LoadSIDData($file);
  }
  if ($UserSID::DATA{$user}) {
    my ($checksha, $checktime) = split(/\t/,$UserSID::DATA{$user},2);
    $sid->{'sha'} = $checksha;
    $sid->{'time'} = $checktime;
    $sid->{'user'} = $user;
    return 1;
  } else {
    return 0;
  }
}
##############################################################################
sub update {
  my $sid = shift;
  my $file = shift || $UserSID::FILE;

  if ((not $sid) || (not $sid->{'user'})) {
    return 0;
  }
  $sid->{'time'} = time;
  return &AddNewSID($sid);
}
##############################################################################
sub remove {
  my $sid = shift;
  my $file = shift || $UserSID::FILE;
  my $key;

  if ((not $sid) || (not $sid->{'user'})) {
    return 0;
  }

  if (not %UserSID::DATA) {
    &LoadSIDData($file);
  }

  delete $UserSID::DATA{$sid->{'user'}};
  return &SaveSIDData($file);

}
##############################################################################
sub create {
  my $sid = shift;
  my $user = shift;
  my $string = shift || localtime;
  my $digest = shift || $UserSID::digest;

  if ((not $sid) || (not $user)) {
    return;
  }

  $sid->{'user'} = $user;
  $sid->{'time'} = time;
  $sid->{'sha'} = &CreateKey($string,$digest);

  return &AddNewSID($sid);
}
##############################################################################
sub new {
  my $that = shift;
  my $file = shift || $UserSID::FILE;
  my $class = ref($that) || $that;
  my $self = {   };

  if (($file ne $UserSID::FILE) || (not %UserSID::DATA)) {
    &LoadSIDData($file);
  }
  bless $self, $class;
  return $self;
}

##############################################################################
# Privat Subroutines
##############################################################################
sub GetSecondaryDN {
  my $string = shift || $ENV{'HTTP_HOST'} || $ENV{'SERVER_NAME'};

  if (not $string) {
    return;
  }
  $string =~ s/^([a-z]+):\/\///;
  if ($string =~ /^([^:\/]+)(:[0-9]+)?/i) {
    $string = $1;
  }
  my @domain = split(/\./,$string);
  my $tld = pop(@domain);
  my $secondary = pop(@domain);
  return "$secondary.$tld";
}
##############################################################################
sub CreateKey {
  my $string = shift;
  my $digest = shift || $UserSID::digest;;
  my $i;
  my $result;

  if ($digest =~ /base/i) {
    $result = sha1_base64($string);
  } elsif ($digest =~ /hex/) {
    $result = sha1_hex($string);
  } else {
    $result = sha1($string);
  }
  while($result =~ /[^a-zA-Z0-9\.\-_]/) {
    $i++;
    $i = $i % 9;
    $result =~ s/[^a-zA-Z0-9\.\-_]/$i/i;
  }

  return $result;
}
##############################################################################
sub AddNewSID {
  my $sid = shift;
  my $file = shift || $UserSID::FILE;
  my $key;

  if ((not $sid) || (not $sid->{'user'})) {
    return 0;
  }

  if (not %UserSID::DATA) {
    &LoadSIDData($file);
  }
  $UserSID::DATA{$sid->{'user'}} = "$sid->{'sha'}\t$sid->{'time'}";
  return &SaveSIDData($file);
}
##############################################################################
sub LoadSIDData {
  my $file = shift;
  my %hash;
  my $lockfile = $file.".pag";


  dbmopen(%hash,$file,0644);
  %UserSID::DATA = %hash;
  dbmclose(%hash);

}
##############################################################################
sub SaveSIDData {
  my $file = shift;
  my %hash = %UserSID::DATA;
  my $lockfile = $file.".pag";

  if (not $file) {
    return 0;
  }

  dbmopen(%hash,$file,0644);
  %hash = %UserSID::DATA;
  dbmclose(%hash);

  return 1;

}
##############################################################################
# EOFunctions
##############################################################################
1;
__END__