"Fossies" - the Fresh Open Source Software Archive

Member "mod_auth_pubtkt-0.14/perl-login/mod_auth_pubtkt.pm" (17 Dec 2020, 7114 Bytes) of package /linux/www/apache_httpd_modules/mod_auth_pubtkt-0.14.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "mod_auth_pubtkt.pm" see the Fossies "Dox" file reference documentation and the last Fossies "Diffs" side-by-side code changes report: 0.9_vs_0.11.

    1 package mod_auth_pubtkt;
    2 
    3 =pod
    4 
    5 =head1 NAME
    6 
    7 pubtkt - Generate Tickets for mod_auth_pubtkt
    8 
    9 =head1 VERSION
   10 
   11 version 0.1
   12 
   13 =cut
   14 our $VERSION = '0.1';
   15 
   16 =pod
   17 
   18 =head1 SYNOPSIS
   19 
   20     use mod_auth_pubtkt;
   21 
   22     ## NOTE: "key.priv.pem" and "key.pub.pem" must already exist.
   23     ## running these should suffice:
   24     ##   openssl genrsa -out key.priv.pem 1024
   25     ##   openssl rsa -in key.priv.pem -out key.pub.pem -pubout
   26     my $ticket = pubtkt_generate(
   27             privatekey => "key.priv.pem",
   28             keytype    => "rsa",
   29             digest     => undef,  # or sha1, dss1, sha224, sha256, sha384, or sha512
   30             clientip   => undef,  # or a valid IP address
   31             userid     => "102",  # or any ID that makes sense to your application, e.g. email
   32             validuntil => time() + 86400, # valid for one day
   33             graceperiod=> 3600,   # grace period of an hour
   34             tokens     => undef,  # comma separated string of tokens.
   35             userdata   => undef   # any application specific data to pass.
   36                  );
   37 
   38     ## $ticket string will look something like: 
   39     ## "uid=102;validuntil=1337899939;graceperiod=1337896339;tokens=;udata=;sig=h5qR" \
   40     ## "yZZDl8PfW8wNxPYkcOMlAxtWuEyU5bNAwEFT9lztN3I7V13SaGOHl+U6wB+aMkvvLQiaAfD2xF/Hl" \
   41     ## "+QmLDEvpywp98+5nRS+GeihXTvEMRaA4YVyxb4NnZujCZgX8IBhP6XBlw3s7180jxE9I8DoDV8bDV" \
   42     ## "k/2em7yMEzLns="
   43     
   44     my $ok = pubtkt_verify (
   45             publickey => "key.pub.pem",
   46             keytype   => "rsa",
   47             digest    => undef,
   48             ticket    => $ticket
   49         );
   50     die "Ticket verification failed.\n" if not $ok;
   51 
   52 =head1 DESCRIPTION
   53 
   54 This module generates and verify a mod_auth_pubtkt-compatible ticket string, which should be used 
   55 as a cookie with the rest of the B<mod_auth_pubtkt> ( L<https://neon1.net/mod_auth_pubtkt/> ) system.
   56 
   57 =head3 Common scenario:
   58 
   59 =over 2
   60 
   61 =item 1.
   62 On the login server side, write perl code to authenticate users (using Apache's authenetication, LDAP, DB, etc.).
   63 
   64 =item 2.
   65 Once the user is authenticated, call C<pubtkt_generate> to generate a ticket, and send it back to the user as a cookie.
   66 
   67 =item 3.
   68 Redirect the user back to the server he/she came from.
   69 
   70 =back
   71 
   72 
   73 =head1 PREREQUISITES
   74 
   75 B<openssl> must be installed (and available on the $PATH).
   76 
   77 L<IPC::Run3> is required to run the openssl executables.
   78 
   79 =head1 BUGS
   80 
   81 Probably many.
   82 
   83 =head1 LICENSE
   84 
   85 Copyright (C) 2012 A. Gordon ( gordon at cshl dot edu ).
   86 
   87 Apache License, same as the rest of B<mod_auth_pubtkt>
   88 
   89 =head1 AUTHORS
   90 
   91 A. Gordon, heavily based on the PHP code from B<mod_auth_pubtkt>.
   92 
   93 =head1 SEE ALSO
   94 
   95 L<https://neon1.net/mod_auth_pubtkt/> 
   96 
   97 C<test_pubtkt.pl> for a usage example.
   98 
   99 =cut
  100 
  101 require Exporter;
  102 our @ISA=qw(Exporter);
  103 our @EXPORT = qw/pubtkt_generate
  104          pubtkt_verify
  105          pubtkt_parse/;
  106 
  107 use strict;
  108 use warnings;
  109 use Carp;
  110 use MIME::Base64;
  111 use File::Temp qw/tempfile/;
  112 use IPC::Run3;
  113 
  114 
  115 ## On unix, assume it's on the $PATH.
  116 ## On Windows - you're on your own.
  117 ## TODO: make this user-configurable.
  118 my $openssl_bin = "openssl";
  119 
  120 =pod
  121 
  122 =cut
  123 sub pubtkt_generate
  124 {
  125     my %args = @_;
  126     my $private_key_file = $args{privatekey} or croak "Missing \"privatekey\" parameter";
  127     croak "Invalid \"privatekey\" value ($private_key_file): file doesn't exist/not readable"
  128         unless -r $private_key_file;
  129 
  130     my $keytype = $args{keytype} or croak "Missing \"keytype\" parameter";
  131     croak "Invalid \"keytype\" value ($keytype): expecting 'dsa' or 'rsa'\n"
  132         unless $keytype eq "dsa" || $keytype eq "rsa";
  133 
  134     my $user_id = $args{userid} or croak "Missing \"userid\" parameter";
  135 
  136     my $valid_until = $args{validuntil} or croak "Missing \"validuntil\" parameter";
  137     croak "Invalid \"validuntil\" value ($valid_until), expecting a numeric value."
  138         unless $valid_until =~ /^\d+$/;
  139 
  140     my $grace_period = $args{graceperiod} || "";
  141     croak "Invalid \"graceperiod\" value ($grace_period), expecting a numeric value."
  142         unless $grace_period eq "" || $grace_period =~ /^\d+$/;
  143 
  144     my $client_ip = $args{clientip} || "";
  145     ##TODO: better IP address validation
  146     croak "Invalid \"client_ip\" value ($client_ip), expecting a valid IP address."
  147         unless $client_ip eq "" || $client_ip =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/;
  148 
  149     my $tokens = $args{tokens} || "";
  150     my $user_data = $args{userdata} || "";
  151 
  152     # Generate Ticket String
  153     my $tkt = "uid=$user_id;" ;
  154     $tkt .= "cip=$client_ip;" if $client_ip;
  155     $tkt .= "validuntil=$valid_until;";
  156     $tkt .= "graceperiod=" . ($valid_until - $grace_period) . ";" if $grace_period;
  157     $tkt .= "tokens=$tokens;";
  158     $tkt .= "udata=$user_data";
  159 
  160     my $algorithm_param = '-'.$args{digest} or ( $keytype eq "dsa" ) ? "-dss1" : "-sha1";
  161     croak "Invalid \"digest\" value ($args{digest}), expecting sha1, dss1, sha224, sha256, sha384, or sha512."
  162         if index(" sha1 dss1 sha224 sha256 sha384 sha512 ", " $args{digest} ") == -1;
  163 
  164     my @cmd = ( $openssl_bin,
  165             "dgst", $algorithm_param,
  166             "-binary",
  167             "-sign", $private_key_file ) ;
  168 
  169     my ($stdin, $stdout, $stderr);
  170 
  171     $stdin = $tkt;
  172     run3 \@cmd, \$stdin, \$stdout, \$stderr;
  173     my $exitcode = $?;
  174 
  175     if ($exitcode != 0) {
  176         warn "pubtkt_generate failed: openssl returned exit code $exitcode, stderr = $stderr\n";
  177         return;
  178     }   
  179 
  180     $tkt .= ";sig=" . encode_base64($stdout,""); #2nd param = no EOL.
  181 
  182     return $tkt;
  183 }
  184 
  185 sub pubtkt_verify
  186 {
  187     my %args = @_;
  188     my $public_key_file = $args{publickey} or croak "Missing \"publickey\" parameter";
  189     croak "Invalid \"publickey\" value ($public_key_file): file doesn't exist/not readable"
  190         unless -r $public_key_file;
  191 
  192     my $keytype = $args{keytype} or croak "Missing \"keytype\" parameter";
  193     croak "Invalid \"keytype\" value ($keytype): expecting 'dsa' or 'rsa'\n"
  194         unless $keytype eq "dsa" || $keytype eq "rsa";
  195     my $algorithm_param = '-'.$args{digest} or ( $keytype eq "dsa" ) ? "-dss1" : "-sha1";
  196     croak "Invalid \"digest\" value ($args{digest}), expecting sha1, dss1, sha224, sha256, sha384, or sha512."
  197         if index(" sha1 dss1 sha224 sha256 sha384 sha512 ", " $args{digest} ") == -1;
  198 
  199     my $ticket_str = $args{ticket} or croak "Missing \"ticket\" parameter";
  200 
  201     # Extract base64'd signature text
  202     my ($ticket_data, $sig_base64) = split /;sig=/, $ticket_str;
  203     warn "Pubtkt.pm: missing \"sig=\" in ticket ($ticket_str)" unless $sig_base64;
  204     return unless $sig_base64;
  205 
  206     # Decode base64 signature, and store in a temporary file
  207     my $sig_bin = decode_base64($sig_base64);
  208     warn "Pubtkt.pm: invalid base64 signature from ticket ($ticket_str)" unless length($sig_bin)>0;
  209 
  210     my ($fh, $temp_sig_file) = tempfile("pubtkt.XXXXXXXXX", UNLINK=>1);
  211     print $fh $sig_bin or die "Failed to write signature data: $!";
  212     close $fh or die "Failed to write signature data: $!";
  213 
  214     # verify signature using openssl
  215     my @cmd = ( $openssl_bin,
  216             "dgst", $algorithm_param,
  217             "-verify", $public_key_file,
  218             "-signature", $temp_sig_file);
  219     my ($stdin, $stdout, $stderr);
  220     $stdin = $ticket_data;
  221     run3 \@cmd, \$stdin, \$stdout, \$stderr;
  222     my $exitcode = $?;
  223     return unless $exitcode == 0;   
  224 
  225     return 1 if ( $stdout eq "Verified OK\n" ) ;
  226 
  227     return ;
  228 }
  229 
  230 sub pubtkt_parse
  231 {
  232     my $tkt = shift or croak "missing ticket string parameter";
  233     my @fields = split /;/, $tkt;
  234     my %values = map { split (/=/, $_, 2) } @fields;
  235     return %values;
  236 }
  237 
  238 1;