From 71e234f246299356342ea3b7191ef28fa68341cf Mon Sep 17 00:00:00 2001 From: Rob van Son Date: Wed, 23 May 2012 16:41:00 +0200 Subject: [PATCH] Refactoring code for Session Tickets --- CGIscriptor.pl | 167 ++++++++++++++++++++++++++++++++------------------------- 1 file changed, 95 insertions(+), 72 deletions(-) diff --git a/CGIscriptor.pl b/CGIscriptor.pl index bc11cb8..0776cf7 100755 --- a/CGIscriptor.pl +++ b/CGIscriptor.pl @@ -339,12 +339,12 @@ $FilePattern =~ s/([@.])/\\$1/g; # Convert . and @ to \. and \@ # # File patterns of files which require a login. %LoginRequiredPatterns = ( -'^/Private/' => ".Sessions\t.Passwords\tLogin.html\t36000" +'^/Private/' => "Private/.Sessions\tPrivate/.Passwords\tLogin.html\t12h" ); # Session Ticket Directory: .Session/ # Password Directory: .Password/ # Login page: Login.html -# Valid for (seconds): 3600 +# Valid for: 12h # # Raw files must contain their own Content-type (xmr <- x-multipart-replace). # THIS IS A SUBSET OF THE FILES DEFINED IN $FilePattern @@ -947,8 +947,8 @@ if(grep(/\-\-help/i, @ARGV)) # defined in %LoginRequiredPatterns as pairs of: # ('regexp' => 'SessionPath\tPasswordPath\tLogin.html'). # Session Tickets are stored in a separate directory (SessionPath, e.g., -# ".Session") as files with the exact same name of the SESSIONTICKET CGI -# variable. Each Session Ticket file has the following structure: +# "Private/.Session") as files with the exact same name of the SESSIONTICKET CGI +# Type: SESSION # IPaddress: <127.0.0.1> # AllowedPaths: <^/Private/Name/> # Expires: <3600> @@ -2635,73 +2635,8 @@ sub Log_In_Access # () -> Access Allowed ($SessionPath, $PasswordsPath, $Login, $valid_duration) = split(/\t/, $LoginRequiredPatterns{$pattern}); # Is there a session ticket of this name? goto Login unless $SESSIONTICKET && (-s "$SessionPath/$SESSIONTICKET"); - # Get SessionTicket file stats - my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) - = stat("$SessionPath/$SESSIONTICKET"); - - # There is a session ticket, is it linked to this IP address? - open(SESSION, "<$SessionPath/$SESSIONTICKET") || die "$SessionPath/$SESSIONTICKET: $!\n"; - my @sessionlines = ; - close(SESSION); - my $IPmatches = 0; - my @IPlines = grep(/^\s*IPaddress:\s+/,@sessionlines); - foreach my $IPline (@IPlines) - { - chomp($IPline); - if($IPline =~ /^\s*IPaddress:\s+(.*)$/) - { - $IPpattern = $1; - $IPpattern =~ s/\./\\./g; - ++$IPmatches if $REMOTE_ADDR =~ m#^$IPpattern$#ig; - }; - }; - goto Login unless !@IPlines || $IPmatches; - - my $Pathmatches = 0; - my @AllowedLines = grep(/^\s*AllowedPaths:\s+/,@sessionlines); - foreach my $Allowedline (@AllowedLines) - { - chomp($Allowedline); - if($Allowedline =~ /^\s*AllowedPaths:\s+(.*)$/) - { - $Pathpattern = $1; - ++$Pathmatches if $PATH_INFO =~ m#$Pathpattern#ig; - }; - }; - goto Login unless !@AllowedLines || $Pathmatches; - - my $Expired = 0; - my @ExpireLines = grep(/^\s*Expires:\s+/,@sessionlines); - foreach my $Expireline (@ExpireLines) - { - chomp($Expireline); - if($Expireline =~ /^\s*Expires:\s+(.*)\s*$/) - { - $ExpireTime = $1; - - if($ExpireTime =~ /\s*d(ays)?\s*$/) - { - $ExpireTime = 24*3600*$`; - } - elsif($ExpireTime =~ /\s*m(inutes)?\s*$/) - { - $ExpireTime = 60*$`; - } - elsif($ExpireTime =~ /\s*h(ours)?\s*$/) - { - $ExpireTime = 3600*$`; - } - elsif($ExpireTime =~ /\s*s(econds)?\s*$/) - { - $ExpireTime = $`; - }; - - my $ActualExpireTime = $ExpireTime + $ctime; - my $CurrentTime = time(); - ++$Expired if($CurrentTime > $ActualExpireTime); - }; - }; - goto Login if @ExpireLines && $Expired; + my $ticket_valid = check_ticket_validity ("SESSION", "$SessionPath/$SESSIONTICKET", $REMOTE_ADDR, $PATH_INFO); + goto Login unless $ticket_valid; return 1; }; @@ -2713,7 +2648,95 @@ sub Log_In_Access # () -> Access Allowed return 0; }; - End of Initialize output +sub check_ticket_validity # ($type, $ticket, $address, $path) +{ + my $type = shift || "SESSION"; + my $ticket = shift || ""; + my $path = shift || ""; + + # Is there a session ticket of this name? + return 0 unless -s "$ticket"; + + # Get SessionTicket file stats + my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) + = stat("$ticket"); + + # There is a session ticket, is it linked to this IP address? + open(SESSION, "<$ticket") || die "$ticket: $!\n"; + my @sessionlines = ; + close(SESSION); + + # Is this the right type of ticket + return unless grep(/Type:\s+$type\s*$/isg, @sessionlines); + + # Does the IP address match? + my $IPmatches = 0; + my @IPlines = grep(/^\s*IPaddress:\s+/isg,@sessionlines); + foreach my $IPline (@IPlines) + { + chomp($IPline); + if($IPline =~ /^\s*IPaddress:\s+(.*)$/) + { + $IPpattern = $1; + $IPpattern =~ s/\./\\./g; + ++$IPmatches if $address =~ m#^$IPpattern$#ig; + }; + }; + return 0 unless !@IPlines || $IPmatches; + + # Is the path allowed + my $Pathmatches = 0; + my @AllowedLines = grep(/^\s*AllowedPaths:\s+/,@sessionlines); + foreach my $Allowedline (@AllowedLines) + { + chomp($Allowedline); + if($Allowedline =~ /^\s*AllowedPaths:\s+(.*)$/) + { + $Pathpattern = $1; + ++$Pathmatches if $path =~ m#$Pathpattern#ig; + }; + }; + return 0 unless !@AllowedLines || $Pathmatches; + + # Is the ticket expired? + my $Expired = 0; + my @ExpireLines = grep(/^\s*Expires:\s+/,@sessionlines); + foreach my $Expireline (@ExpireLines) + { + chomp($Expireline); + if($Expireline =~ /^\s*Expires:\s+(.*)\s*$/) + { + $ExpireTime = $1; + + if($ExpireTime =~ /\s*d(ays)?\s*$/) + { + $ExpireTime = 24*3600*$`; + } + elsif($ExpireTime =~ /\s*m(inutes)?\s*$/) + { + $ExpireTime = 60*$`; + } + elsif($ExpireTime =~ /\s*h(ours)?\s*$/) + { + $ExpireTime = 3600*$`; + } + elsif($ExpireTime =~ /\s*s(econds)?\s*$/) + { + $ExpireTime = $`; + }; + + my $ActualExpireTime = $ExpireTime + $ctime; + my $CurrentTime = time(); + ++$Expired if($CurrentTime > $ActualExpireTime); + }; + }; + return 0 if @ExpireLines && $Expired; + + return 1; + +}; + +# Handle login access # # ############################################################################ -- 2.11.4.GIT