"Fossies" - the Fresh Open Source Software Archive

Member "mod_auth_pubtkt-0.14/perl-login/test_pubtkt.pl" (17 Dec 2020, 1196 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. See also the last Fossies "Diffs" side-by-side code changes report for "test_pubtkt.pl": 0.9_vs_0.11.

    1 #!/usr/bin/env perl
    2 =pod
    3  Perl implementation of mod_auth_pubtkt  ticket generateion.
    4 
    5  see https://neon1.net/mod_auth_pubtkt/ for more details.
    6 
    7  Copyright (C) 2012 A. Gordon ( gordon at cshl dot edu )
    8 
    9  LICENSE: Apacle License (see LICENSE file)
   10 
   11  See README.perl.md file for more details.
   12 =cut
   13 use strict;
   14 use warnings;
   15 use mod_auth_pubtkt;
   16 
   17 ##
   18 ## Generate a ticket
   19 ##
   20 my $ticket = pubtkt_generate(
   21         privatekey => "key.priv.pem",
   22         keytype    => "rsa",
   23         digest     => undef,
   24         clientip   => undef,
   25         userid     => "102",
   26         validuntil => time() + 86400,
   27         graceperiod=> 3600,
   28         tokens     => undef,
   29         userdata   => undef);
   30 
   31 print $ticket,"\n";
   32 ##
   33 ## Verify the same ticket
   34 ##
   35 my $ok = pubtkt_verify (
   36         publickey => "key.pub.pem",
   37         keytype   => "rsa",
   38         digest    => undef,
   39         ticket    => $ticket
   40     );
   41 die "Ticket verification failed.\n" if not $ok;
   42 
   43 ##
   44 ## Change something in the ticket, then verify again (which should fail)
   45 ##
   46 $ticket =~ s/uid=102/uid=103/;
   47 
   48 $ok = pubtkt_verify (
   49         publickey => "key.pub.pem",
   50         keytype   => "rsa",
   51         digest    => undef,
   52         ticket    => $ticket
   53     );
   54 
   55 die "Error: forged ticket verified successfully, something is terribly wrong." if $ok;
   56 
   57 print "all ok\n";