cgi-auth-hybrid.pm

   1 # -*- perl -*-
   2
   3 # This is part of CGI::Auth::Hybrid, a perl CGI authentication module.
   4 # Copyright (C) 2012 Ian Jackson.
   5 #
   6 # This program is free software: you can redistribute it and/or modify
   7 # it under the terms of the GNU Affero General Public License as published by
   8 # the Free Software Foundation, either version 3 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU Affero General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU Affero General Public License
  17 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 BEGIN {
  20     use Exporter   ();
  21     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  22
  23     $VERSION     = 1.00;
  24     @ISA         = qw(Exporter);
  25     @EXPORT      = qw();
  26     %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
  27
  28     @EXPORT_OK   = qw(setup);
  29 }
  30 our @EXPORT_OK;
  31
  32 use DBI;
  33 use CGI;
  34 use Locale::Gettext;
  35
  36 #---------- public utilities ----------
  37
  38 sub flatten_params ($) {
  39     my ($p) = @_;
  40     my @p;
  41     foreach my $k (keys %$p) {
  42         foreach my $v (@{ $p->{$k} }) {
  43             push @p, $k, $v;
  44         }
  45     }
  46     return @p;
  47 }
  48
  49 #---------- default callbacks ----------
  50
  51 sub has_a_param ($$) {
  52     my ($c,$cn) = @_;
  53     foreach my $pn (@{ $r->{S}{$cn} }) {
  54         return 1 if $r->_cm('get_param')($pn);
  55     }
  56     return 0;
  57 }
  58
  59 sub get_params ($$) {
  60     my ($c) = @_;
  61     my %p;
  62     foreach my $name ($c->param()) {
  63         $p{$name} = [ $c->param($name) ];
  64     }
  65     return \%p;
  66 }
  67
  68 sub get_cookie_domain ($$$) {
  69     my ($c,$r) = @_;
  70     my $uri = new URI $r->_ch('get_url');
  71     return $uri->host();
  72 }
  73
  74 sub construct_cookie ($$$) {
  75     my ($c, $r, $cookv) = @_;
  76     return $c->cookie(-name => $r->{S}{cookie_name},
  77                       -value => $cookv,
  78                       -path => $r->{S}{cookie_path},
  79                       -domain => $r->_ch('get_cookie_domain'),
  80                       -expires => '+'.$r->{S}{login_timeout}.'s',
  81                       -secure => $r->{S}{encrypted_only});
  82 }
  83
  84 sub do_redirect_cgi ($$$$) {
  85     my ($c, $r, $new_url, $cookie) = @_;
  86     my @ha = ('text/html',
  87               -status => '303 See other',
  88               -location => $new_url);
  89     push @ha, (-cookie => $cookie) if defined $cookie;
  90     $r->_print($c->header(@ha),
  91                $r->_ch('gen_start_html')($r->_gt('Redirection')),
  92                '<a href="'.escapeHTML($new_url).'">',
  93                $r->_gt("If you aren't redirected, click to continue."),
  94                "</a>",
  95                $c->_ch('gen_end_html'));
  96 }
  97
  98 sub gen_plain_login_form ($$) {
  99     my ($c,$r, $params) = @_;
 100     my @form;
 101     push @form, ('<form method="POST" action="'.
 102                  escapeHTML($r->_ch('get_url')).'>'.
 103                  '<table>');
 104     my $sz = 'size="'.$r->{S}{form_entry_size}.'"';
 105     foreach my $up (@{ $r->{S}{username_param_names}}) {
 106         push @form, ('<tr><td>',$r->_gt(ucfirst $up),'</td>',
 107                      '<td><input type="text" ',$sz.
 108                      ' name=',$up,'></td></tr>');
 109     }
 110     push @form, ('<tr><td>'.$r->_gt('Password'),'</td>',
 111                  '<td><input type="password" '.$sz.
 112                  ' name="'.$r->{S}{password_param_name}.'"></td></tr>');
 113     push @form, ('<tr><td colspan="2">',
 114                  '<input type="submit"'.
 115                  ' name="'.$r->{S}{login_submit_name}.'"'.
 116                  ' value="'.$r->_gt('Login').'"></td></tr>',
 117                  '</table>');
 118     foreach my $n (keys %$params) {
 119         push @form, ('<input type="hidden"'.
 120                      ' name="'.$n.'"'.
 121                      ' value="'.$params->{$n}.'">');
 122     }
 123     push @form, ('</form>');
 124     return join "\n", @form;
 125 }
 126
 127 sub gen_login_link ($$) {
 128     my ($c,$r, $params) = @_;
 129     my $url = $r->url_with_query_params($params);
 130     return ('<a href="'.escapeHTML($url).'">'.
 131             $r->_gt('Log in again to continue.').
 132             '</a>');
 133 }
 134
 135 #---------- verifier object methods ----------
 136
 137 sub new_verifier {
 138     my $class = shift;
 139     my $s = {
 140         S => {
 141             assocdb_path => 'cah-assocs.db';
 142             assocdb_dsn => undef,
 143             assocdb_user => '',
 144             assocdb_password => '',
 145             assocdb_table => 'assocs',
 146             random_source => '/dev/urandom',
 147             associdlen => 128, # bits
 148             login_timeout => 86400, # seconds
 149             assoc_param_name => 'cah_associd',
 150             password_param_name => 'password',
 151             username_param_names => [qw(username)],
 152             form_entry_size => 60,
 153             logout_param_names => [qw(cah_logout)],
 154             login_submit_name => [qw(cah_login)],
 155             loggedout_param_names => [qw(cah_loggedout)],
 156             promise_check_mutate => 0,
 157             get_param => sub { $_[0]->param($_[2]) },
 158             get_params => sub { $_[1]->get_params() },
 159             get_cookie => sub { $_[0]->cookie($s->{S}{cookie_name}) },
 160             get_method => sub { $_[0]->request_method() },
 161             get_url => sub { $_[0]->url(); },
 162             is_login => sub { defined $_[1]->_rp('password_param_name') },
 163             login_ok => sub { die },
 164             is_logout => sub { $_[1]->has_a_param('logout_param_names') },
 165             is_loggedout => sub { $_[1]->has_a_param('loggedout_param_names') },
 166             is_page => sub { return 1 },
 167             handle_divert => sub { return 0 },
 168             do_redirect => \&do_redirect_cgi, # this hook is allowed to throw
 169             cookie_path => "/",
 170             get_cookie_domain => \&get_cookie_domain,
 171             encrypted_only => 0,
 172             gen_start_html => sub { $_[0]->start_html($_[2]); },
 173             gen_end_html => sub { $_[0]->end_html(); },
 174             gen_login_form => \&gen_plain_login_form,
 175             gen_login_link => \&gen_plain_login_link,
 176             gettext => sub { gettext($_[2]); },
 177             };
 178         },
 179         Dbh => undef,
 180     };
 181     my ($k,$v);
 182     while (($k,$v,@_) = @_) {
 183         die "unknown setting $k" unless exists $s->{S}{$k};
 184         $s->{S}{$k} = $v;
 185     }
 186     bless $s, $class;
 187     $s->_dbopen();
 188     return $s;
 189 }
 190
 191 sub _dbopen ($) {
 192     my ($s) = @_;
 193     my $dbh = $s->{Dbh};
 194     return $dbh if $dbh;
 195
 196     $s->{S}{assocdb_dsn} ||= "dbi:SQLite:dbname=$s->{S}{assocdb_path}";
 197
 198     my $u = umask 077;
 199     $dbh = DBI->open($s->{S}{assocdb_dsn}, $s->{S}{assocdb_user},
 200                      $s->{S}{assocdb_password}, {
 201                          AutoCommit => 0, RaiseError => 1,
 202                      });
 203     die "${assocdb_dsn} $! ?" unless $dbh;
 204     $s->{Dbh} = $dbh;
 205
 206     $dbh->do("BEGIN");
 207
 208     eval {
 209         $dbh->do("CREATE TABLE $s->{S}{assocdb_table} (".
 210                  " associdh VARCHAR PRIMARY KEY,".
 211                  " username VARCHAR,".
 212                  " last INTEGER NOT NULL"
 213                  ")");
 214     };
 215     return $dbh;
 216 }
 217
 218 #---------- request object methods ----------
 219
 220 sub new_request {
 221     my ($classbase, $cgi, @extra) = @_;
 222     if (!ref $classbase) {
 223         $classbase = $classbase->new_verifier(@extra);
 224     } else {
 225         die if @extra;
 226     }
 227     my $r = {
 228         V => $classbase,
 229         S => $classbase->{S},
 230         Dbh => $classbase->{Dbh},
 231         Cgi => $cgi,
 232     };
 233     bless $r, ref $classbase;
 234 }
 235
 236 sub _ch ($$@) { # calls an application hook
 237     my ($r,$methname, @args) = @_;
 238     my $methfunc = $r->{S}{$methname};
 239     return $methfunc->($r->{Cgi}, $r, @args);
 240 }
 241
 242 sub _rp ($$@) {
 243     my ($r,$pnvb) = @_;
 244     my $pn = $r->{S}{$pnvb};
 245     my $p = scalar $r->_ch('get_param',$pn)
 246 }
 247
 248 sub _gt ($$) { my ($r, $t) = @_; return $r->_ch('gettext')($t); }
 249 sub _print ($$) { my ($r, @t) = @_; return $r->_ch('print')(join '', @t); }
 250
 251 # pages/param-sets are
 252 #   n normal non-mutating page
 253 #   r retrieval of information for JS, non-mutating
 254 #   m mutating page
 255 #   u update of information by JS, mutating
 256 #   i login
 257 #   o logout
 258 #   O "you have just logged out" page load
 259
 260 # in cook and par,
 261 #    a, aN     anything including -
 262 #    t, tN     temporary value (in our db, no logged in user yet)
 263 #    y, yN     value corresponds to logged-in user
 264 #    n, nN     value not in our db
 265 #    x, xN     t or y
 266 #    -         no value supplied
 267 # if N differs the case applies only when the two values differ
 268 # (eg,   a1 y2   does not apply when the logged-in value is supplied twice)
 269
 270 # "stale session" means request originates from a page from a login
 271 # session which has been revoked (eg by logout); "cleared session"
 272 # means request originates from a browser which has a different (or
 273 # no) cookie.
 274
 275     # Case analysis, cookie mode, app promises re mutate:
 276     # cook parm meth form
 277     #
 278     #  any -   POST  nrmuoi   bug or attack, fail
 279     #  any -   GET    rmuoi   bug or attack, fail
 280     #  any any GET     muoi   bug or attack, fail
 281     #  any t   any   nrmu     bug or attack, fail
 282     #
 283     #  -   -   GET         O  "just logged out" page
 284     #  (any other)         O  bug or attack, fail
 285     #
 286     #  a1  a2  POST      o    logout
 287     #                           if a1 is valid, revoke it
 288     #                           if a2 is valid, revoke it
 289     #                           delete cookie
 290     #                           redirect to "just logged out" page
 291     #                             (which contains link to login form)
 292     #
 293     #  -   t   POST       i   complain about cookies being disabled
 294     #                           (with link to login form)
 295     #
 296     #  any n   POST       i   complain about stale login form
 297     #                           show new login form
 298     #
 299     #  x1  t2  POST       i   login (or switch user)
 300     #                           if bad
 301     #                             show new login form
 302     #                           if good
 303     #                             revoke x1 if it was valid and !=t2
 304     #                             upgrade t2 to y2 in our db (setting username)
 305     #                             set cookie to t2
 306     #                             redirect to GET of remaining params
 307     #
 308     #  t1  a2  ANY   nrmu     treat as  - a2 ANY
 309     #
 310     #  y   -   GET   n        cross-site link
 311     #                           show data
 312     #
 313     #  y   y   GET   nr       fine, show page or send data
 314     #  y   y   POST  nrmu     mutation is OK, do operation
 315     #
 316     #  y1  y2  GET   nr       request from stale page
 317     #                           do not revoke y2 as not RESTful
 318     #                           treat as   y1 n GET
 319     #
 320     #  y1  y2  POST  nrmu     request from stale page
 321     #                           revoke y2
 322     #                           treat as   y1 n POST
 323     #
 324     #  y   n   GET   n        intra-site link from stale page,
 325     #                           treat as cross-site link, show data
 326     #
 327     #  y   n   POST  n m      intra-site form submission from stale page
 328     #                           show "session interrupted"
 329     #                           with link to main data page
 330     #
 331     #  y   n   GET    r       intra-site request from stale page
 332     #                           fail
 333     #
 334     #  y   n   POST   r u     intra-site request from stale page
 335     #                           fail
 336     #
 337     #  -/n y2  GET   nr       intra-site link from cleared session
 338     #                           do not revoke y2 as not RESTful
 339     #                           treat as   -/n n GET
 340     #
 341     #  -/n y2  POST  nrmu     request from cleared session
 342     #                           revoke y2
 343     #                           treat as   -/n n POST
 344     #
 345     #  -/n n   GET   n        cross-site link but user not logged in
 346     #                           show login form with redirect to orig params
 347     #
 348     #  -/n n   GET    rmu     user not logged in
 349     #                           fail
 350     #
 351     #  -/n n   POST  n m      user not logged in
 352     #                           show login form
 353     #
 354     #  -/n n   POST   r u     user not logged in
 355     #                           fail
 356
 357 sub _check_divert_core ($) {
 358 fixme needs wrapping with something to make and commit a transaction
 359 wrapper should also store answers in the $r object for later retrieval
 360     my ($r) = @_;
 361
 362     my $meth = $r->_ch('get_method');
 363     my $cookv = $r->_ch('get_cookie');
 364     my $parmv = $r->_rp('assoc_param_name');
 365
 366     my ($cookt,$cooku) = $r->_db_lookup($cookv);
 367     my $parmt = $r->_db_lookup($parmv);
 368
 369     if ($r->_ch('is_logout')) {
 370         $r->_must_be_post();
 371         die unless $parmt;
 372         $r->_db_revoke($cookv);
 373         $r->_db_revoke($parmv);
 374         return ({ Kind => 'REDIRECT-LOGGEDOUT',
 375                   Message => "Logging out...",
 376                   Cookie => '',
 377                   Params => { } });
 378     }
 379     if ($r->_ch('is_loggedout')) {
 380         die unless $meth eq 'GET';
 381         die unless $cookt;
 382         die unless $parmt;
 383         return ({ Kind => 'SMALLPAGE-LOGGEDOUT',
 384                   Message => "You have been logged out.",
 385                   Cookie => '',
 386                   Params => { } });
 387     }
 388     if ($r->_ch('is_login')) {
 389         $r->_must_be_post();
 390         return ({ Kind => 'LOGIN-STALE',
 391                   Message => "Stale session; you need to log in again.",
 392                   Cookie => $r->_fresh_cookie(),
 393                   Params => { } })
 394             if $parmt eq 'n';
 395         die unless $parmt eq 't' || $parmt eq 'y';
 396         return ({ Kind => 'SMALLPAGE-NOCOOKIE',
 397                   Message => "You do not seem to have cookies enabled.  ".
 398                       "You must enable cookies as we use them for login.",
 399                   Cookie => $r->_fresh_cookie(),
 400                   Params => $r->_chain_params() })
 401             if !$cookt && $parmt eq 't';
 402         my $username = $r->_ch('login_ok');
 403         return ({ Kind => 'LOGIN-BAD',
 404                   Message => "Incorrect username/password.",
 405                   Cookie => $cookv,
 406                   Params => $r->_chain_params() })
 407             unless defined $username && length $username;
 408         $r->_db_revoke($cookv)
 409             if defined $cookv && !(defined $parmv && $cookv eq $parmv);
 410         $r->_db_record_login_ok($parmv,$username);
 411         return ({ Kind => 'REDIRECT-LOGGEDIN',
 412                   Message => "Logging in...",
 413                   Cookie => $parmv,
 414                   Params => $r->_chain_params() });
 415     }
 416     if ($cookt eq 't') {
 417         $cookt = '';
 418     }
 419     die if $parmt eq 't';
 420
 421     if ($cookt eq 'y' && $parmt eq 'y' && $cookv ne $parmv) {
 422         $r->_db_revoke($parmv) if $meth eq 'POST';
 423         $parmt = 'n';
 424     }
 425
 426     if ($cookt ne 'y') {
 427         die unless !$cookt || $cookt eq 'n';
 428         die unless !$parmt || $parmt eq 'n' || $parmt eq 'y';
 429         if ($meth eq 'GET') {
 430             return ({ Kind => 'LOGIN-INCOMINGLINK',
 431                       Message => "You need to log in again.",
 432                       Cookie => $parmv,
 433                       Params => $r->_chain_params() });
 434         } else {
 435             return ((Kind => 'LOGIN-FRESH',
 436                      Message => "You need to log in again.",
 437                      Cookie => $parmv,
 438                      Params => { });
 439         }
 440     }
 441
 442     if (!$r->{S}{promise_check_mutate}) {
 443         if ($meth ne 'POST') {
 444             return ({ Kind => 'MAINPAGEONLY',
 445                       Message => 'Entering via cross-site link.',
 446                       Cookie => $cookv,
 447                       Params => { } });
 448             # NB caller must then ignore params & path!
 449             # if this is too hard they can spit out a small form
 450             # with a "click to continue"
 451         }
 452     }
 453
 454     die unless $cookt eq 'y';
 455     die unless $parmt eq 'y';
 456     die unless $cookv eq $parmv;
 457     $r->{UserOK} = $cooku;
 458     return undef;
 459 }
 460
 461 sub _chain_params ($) {
 462     my ($r) = @_;
 463     my %p = %{ $r->_ch('get_params') };
 464     foreach my $pncn (keys %{ $r->{S} }) {
 465         if ($pncn =~ m/_param_name$/) {
 466             my $name = $r->{S}{$pncn};
 467             die "$pncn ?" if ref $name;
 468             $names = [ $name ];
 469         } elsif ($pncn =~ m/_param_names$/) {
 470             $names = $r->{S}{$pncn};
 471         } else {
 472             next;
 473         }
 474         foreach my $param (@$names) {
 475             delete $p{$name};
 476         }
 477     }
 478     return \%p;
 479 }
 480
 481 sub _db_lookup ($$) {
 482     # returns ($t,$username)
 483     # where $t is one of "t" "y" "n", or "" (for -)
 484     my ($r,$v) = @_;
 485
 486     my $dbh = $r->{Dbh};
 487
 488     my ($nusername, $nlast) =
 489         $dbh->selectrow_array("SELECT username, last".
 490                               " FROM $r->{S}{assocdb_table}".
 491                               " WHERE associd = ?", {}, $nassoc);
 492     return ('') unless defined $nusername;
 493
 494     my $timeout = $r->{S}{login_timeout};
 495     return ('n') unless !defined $timeout || time <= $nlast + $timeout;
 496
 497     return ('t') unless defined $nusername;
 498
 499     # hooray
 500     return ('y', $nusername);
 501 }
 502
 503 sub _db_revoke ($$) {
 504     # revokes $v if it's valid; no-op if it's not
 505     my ($r,$v) = @_;
 506
 507     my $dbh = $r->{Dbh};
 508
 509     $dbh->do("DELETE FROM $r->{S}{assocdb_table}".
 510              " WHERE associd = ?", {}, $v);
 511 }
 512
 513 sub _db_record_login_ok ($$$) {
 514     my ($r,$v,$user) = @_;
 515     $r->_db_revoke($v);
 516     $dbh->do("INSERT INTO $r->{S}{assocdb_table}".
 517              " (associd, username, last) VALUES (?,?,?)", {},
 518              $v, $user, time);
 519 }
 520
 521 sub url_with_query_params ($$) {
 522     my ($r, $params) = @_;
 523     my $uri = URI->new($r->_ch('get_url'));
 524     $uri->query_form(flatten_params($params));
 525     return $uri->as_string();
 526 }
 527
 528 sub check_ok ($) {
 529     my ($r) = @_;
 530
 531     my ($divert) = $authreq->check_divert();
 532     return 1 if $divert;
 533
 534     my $handled = $r->_ch('handle_divert')($divert);
 535     return 0 if $handled;
 536
 537     my $kind = $divert->{Kind};
 538     my $cookie = $divert->{Cookie};
 539     my $params = $divert->{Params};
 540
 541     if ($kind =~ m/^REDIRECT-/) {
 542         # for redirects, we honour stored NextParams and SetCookie,
 543         # as we would for non-divert
 544         if ($divert_kind eq 'REDIRECT-LOGGEDOUT') {
 545             $params{$r->{S}{loggedout_param_names}[0]} = 1;
 546         } elsif ($divert_kind eq 'REDIRECT-LOGOUT') {
 547             $params{$r->{S}{logout_param_names}[0]} = 1;
 548         } elsif ($divert_kind eq 'REDIRECT-LOGGEDIN') {
 549         } else {
 550             die;
 551         }
 552         my $new_url = $r->url_with_query_params($params);
 553         $r->_ch('do_redirect')($new_url, $cookie);
 554         return 0;
 555     }
 556
 557     my ($title, @body);
 558     if ($kind =~ m/^LOGIN-/) {
 559         $title = $r->_gt('Login');
 560         push @body, $r->_gt($divert->{Message});
 561         push @body, $r->_ch('gen_login_form', $params);
 562     } elsif ($kind =~ m/^SMALLPAGE-/) {
 563         $title = $r->_gt('Not logged in');
 564         push @body, $r->_gt($divert->{Message});
 565         push @body, $r->_ch('gen_login_link');
 566     } else {
 567         die $kind;
 568     }
 569
 570     $r->_print($r->_ch('start_html')($title),
 571                @body,
 572                $r->_ch('end_html'));
 573     return 0;
 574 }
 575
 576 sub _random ($$) {
 577     my ($r, $bytes) = @_;
 578     my $v = $r->{V};
 579     if (!$v->{RandomHandle}) {
 580         my $rsp = $r->{S}{random_source};
 581         my $rsf = new IO::File $rsp, '<' or die "$rsp $!";
 582         $v->{RandomHandle} = $rsf;
 583     }
 584     my $bin;
 585     $!=0;
 586     read($rsf,$bin,$bytes) == $bytes or die "$rsp $!";
 587     close $rsf;
 588     return unpack "H*", $bin;
 589 }
 590
 591 sub _fresh_cookie ($) {
 592     my ($r) = @_;
 593     my $bytes = ($r->{S}{associdlen} + 7) >> 3;
 594     return $r->_random($bytes);
 595 }
 596
 597 UP TO HERE
 598
 599 sub record_login ($$) {
 600     my ($r,$nusername) = @_;
 601
 602
 603
 604     my $dbh = $r->{Dbh};
 605
 606     $r->{U} = $nusername;
 607     $r->{A} = $nassoc;
 608
 609     $dbh->do("COMMIT");
 610 }
 611
 612 sub _check ($) {
 613     my ($r) = @_;
 614
 615     return if exists $r->{Username};
 616     ($r->{Username}, $r->{Assoc}, $r->{Mutate}) = $r->_check();
 617
 618     if (defined $r->{Assoc}) {
 619         $dbh->do("UPDATE $r->{S}{assocdb_table}".
 620                  " SET last = ?".
 621                  " WHERE associd = ?", {}, time, $nassoc);
 622         $dbh->do("COMMIT");
 623     }
 624 }
 625
 626 sub logout ($) {
 627     my ($r) = @_;
 628
 629     my ($nusername, $nassoc, $nmutate) = $r->_check();
 630     return undef unless $nmutate;
 631     $dbh->do("DELETE FROM $r->{S}{assocdb_table}".
 632              " WHERE associd = ?", {}, $nassoc);
 633     $dbh->do("COMMIT");
 634     return $nusername;
 635 }
 636
 637 sub check ($) {
 638     my ($r) = @_;
 639     $r->_check();
 640     return !!defined $r->{Username};
 641 }
 642
 643 sub check_mutate ($) {
 644     my ($r) = @_;
 645     $r->check();
 646     return $r->{Mutate};
 647 }
 648
 649 sub username ($) {
 650     my ($r) = @_;
 651     $r->check();
 652     return $r->{Username};
 653
 654 sub hidden_val ($) {
 655     my ($r) = @_;
 656     $r->check();
 657     return defined $r->{Assoc} ? $r->{Assoc} : '';
 658 }
 659
 660 #---------- simple wrappers ----------
 661
 662 sub hidden_hargs ($) {
 663     my ($r) = @_;
 664     return (-name => $r->{S}{param_name},
 665             -default => $r->hidden_val());
 666 }
 667
 668 sub hidden_html ($) {
 669     my ($r) = @_;
 670     return hidden($r->hidden_hargs());
 671 }
 672
 673 sub cookiea_cargs ($) {
 674     my ($r) = @_;
 675     return (-name => $r->{S}{cookie_name},
 676             -value => hidden_val());
 677 }
 678
 679 __END__
 680
 681 =head1 NAME
 682
 683 CGI::Auth::Hybrid - web authentication optionally using cookies
 684
 685 =head1 SYNOPSYS
 686
 687  my $verifier = CGI::Auth::Hybrid->new_verifier(setting => value,...);
 688  my $authreq = $verifier->new_request($cgi_request_object);
 689
 690  my $authreq = CGI::Auth::Hybrid->new_request($cgi_request_object,
 691                                               setting => value,...);
 692
 693 =head1 USAGE PATTERN FOR SIMPLE APPLICATIONS
 694
 695  $authreq->check_ok() or return;
 696
 697  blah blah blah
 698  $authreq->mutating();
 699  blah blah blah
 700
 701 =head1 USAGE PATTERN FOR FANCY APPLICATIONS
 702
 703  my $divert_kind = $authreq->check_divert();
 704  if ($divert_kind) {
 705      if ($divert_kind eq 'LOGGEDOUT') {
 706          print "goodbye you are now logged out" and quit
 707      } elsif ($divert_kind eq 'NOCOOKIES') {
 708          print "you need cookies" and quit
 709      ... etc.
 710      }
 711  }
 712