"Fossies" - the Fresh Open Source Software Archive

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


The requested HTML page contains a <FORM> tag that is unusable on "Fossies" in "automatic" (rendered) mode so that page is shown as HTML 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 "login.pl" see the Fossies "Dox" file reference documentation and the last Fossies "Diffs" side-by-side code changes report: 0.9_vs_0.11.

    1 #!/usr/bin/env perl
    2 use strict;
    3 use warnings;
    4 use FindBin;
    5 use lib "$FindBin::Bin/../";
    6 use mod_auth_pubtkt;
    7 use CGI qw(:standard  :cgi-lib);
    8 use CGI::Carp qw/fatalsToBrowser/;
    9 use URI::Escape;
   10 use Data::Dump qw/dump/;
   11 $CGI::POST_MAX=1024 * 10;  # max 10K posts
   12 $CGI::DISABLE_UPLOADS = 1;  # no uploads
   13 
   14 sub show_login_page;
   15 sub show_post_page;
   16 sub post_successful_login;
   17 sub validate_login;
   18 
   19 ##
   20 ## Configuration parameters.
   21 ## These must match the corresponding "mod_auth_pubtkt" settings on every apache handler server.
   22 ##
   23 my $mod_auth_pubtkt_cookie = "auth_pubtkt"; # mod_auth_pubtkt's TKTAuthCookieName setting.
   24 my $mod_auth_cookie_domain = ".cshl.edu"; # the domain for which this cookie is valid.
   25 my $tokens = ""; # mod_auth_pubtkt's TKTAuthToken setting. This default implementation doesn't send any tokens.
   26 my $user_data = "" ; # This default implementation doesn't send any user-data.
   27 my $valid_until_delta = 86400 ; # Valid for one day
   28 my $grace_period = 3600 ; # Grace period of one hour
   29 my $use_client_ip = 1 ; # should the ticket/cookie contain the client's IP address?
   30 
   31 ## TODO: DO NOT USE THESE keys in a production settings.
   32 ##       These are just for debugging/testing.
   33 my $key_type = "rsa";
   34 my $digest = undef; # defaults to sha1 or dss1, depending on $key_type
   35 my $public_key = "$FindBin::Bin/../key.pub.pem";
   36 my $private_key = "$FindBin::Bin/../key.priv.pem";
   37 
   38 
   39 =head1 Technical note
   40 
   41 =head2 This login script can be invoked in one of several ways:
   42 
   43 =over 2
   44 
   45 =item C<GET> request, with possibly a C<back>, C<timeout>, C<unauth> CGI parameters.
   46 
   47 foo bar
   48 
   49 =item C<GET> request, with a C<auth_pubtkt> cookie, (and possibly C<back>, C<unauth>, C<timeout> CGI parameters) 
   50 
   51 foo bar
   52 
   53 =item C<POST> request, with a possible C<back> CGI GET paramter, and C<username> and C<password> POST CGI parameters.
   54 
   55 foo bar
   56 
   57 =back
   58 
   59 =cut
   60 
   61 ###########################################################
   62 ## CGI Script Starts here
   63 ###########################################################
   64 if (request_method() eq "GET") {
   65     show_login_page();
   66 }
   67 elsif (request_method() eq "POST") {
   68     ## User tried to login, verify username/password, and issue a ticket.
   69     if (validate_login()) {
   70         post_successful_login();
   71     } else {
   72         show_login_page("Login failed. Please try again");
   73     }
   74 } else {
   75     ## We don't susport anything else other than GET/POST. no HEAD, PUT, DELETE, etc.
   76     die "What's going on? unknown request method: " . request_method() ;
   77 }
   78 ###########################################################
   79 ## CGI Script End
   80 ###########################################################
   81 
   82 
   83 sub show_login_page
   84 {
   85     my $message = shift || "";
   86 
   87     my $back = url_param('back') || "";
   88     if ($back) {
   89         $back = "back=" .uri_escape($back);
   90     }
   91 
   92     print header(); # HTTP header, back to apache
   93     #The simplest login HTML <form> page
   94     print <<HTML;
   95 <html>
   96 <head>
   97 </head>
   98 <body>
   99 <form action="?$back" method="post">
  100 <center>
  101 <table>
  102     <tr>
  103         <td colspan="2"><h1>Login</h1></td>
  104     </tr>
  105     <tr>
  106         <td colspan="2"><h2>$message</h2></td>
  107     </tr>
  108     <tr>
  109         <td><b>Name:</b></td>
  110         <td><input type="text" name="username" value=""/></td>
  111     </tr>
  112     <tr>
  113         <td><b>Password:</b></td>
  114         <td><input type="password" name="password" value=""/></td>
  115     </tr>
  116     <tr>
  117         <td colspan="2"><input type="submit" name="login" value="login"/></td>
  118     </tr>
  119 </table>
  120 </center>
  121 </form>
  122 </body>
  123 </html>
  124 HTML
  125 }
  126 
  127 =pod
  128   Get the username/password from the POST parameters, try to authenticate the user.
  129 
  130   return FALSE on any failure, or TRUE if login was successful.
  131 
  132   TODO:
  133     Implement it in which every way you want (DB, LDAP, PAM, Text file, etc.)
  134 =cut
  135 sub validate_login
  136 {
  137     my $username = param("username") || "";
  138     my $password = param("password") || "";
  139 
  140     # This seems pretty much bullet-proof secure :)
  141     return ( $username eq "gordon" && $password eq "12345" );
  142 }
  143 
  144 =pod
  145   Generate the cookie, with the signed ticket,
  146   and all other parameters. 
  147 =cut
  148 sub generate_pubtkt_cookie
  149 {
  150     my ($user_id) = shift or croak "Error: missing user_id parameter.";
  151 
  152     my $ticket = pubtkt_generate(
  153             privatekey => $private_key,
  154             keytype    => $key_type,
  155             digest     => $digest,
  156             clientip   => ($use_client_ip) ? remote_addr() : undef,
  157             userid     => $user_id,
  158             validuntil => time() + $valid_until_delta,
  159             graceperiod=> $grace_period,
  160             tokens     => $tokens,
  161             userdata   => $user_data);
  162 
  163     my $cookie = cookie(-name  => $mod_auth_pubtkt_cookie,
  164                 -value => $ticket,
  165                 -domain=> $mod_auth_cookie_domain,
  166                 -path  => "/");
  167 
  168     return $cookie;
  169 }
  170 
  171 =pod
  172  What to do after the user successfully logged on?
  173  (either by entering username/password, or by renewing a grace-period)
  174 
  175  1. Set a new mod_auth_pubtkt cookie
  176  2. If there's a "back" CGI parameter, redirect the user there.
  177  3. If there's no "back", show something else.
  178 =cut
  179 sub post_successful_login
  180 {
  181     my $cookie = generate_pubtkt_cookie(param("username"));
  182 
  183     my $back = url_param('back') || "" ;
  184     if ($back) {
  185         ## Send the user back were he/she came from, this time with a cookie
  186         print redirect( -url => $back, -cookie => $cookie );
  187         exit(0);
  188     }
  189 
  190     ##
  191     ## Don't knwo where the user came from, show some generic message (and set the cookie).
  192     ## possibly show "portal" - a list of other services using this ticket authentication system.
  193     ##
  194     print header(-cookie => $cookie); # HTTP header, back to apache
  195     print <<HTML;
  196 <html>
  197 <head>
  198 </head>
  199 <body>
  200 <center>
  201 <h1>Good, now go away</h1>
  202 </center>
  203 </body>
  204 </html>
  205 HTML
  206 }