decoded results from the CPAN

CGI-AuthRegister
view release on metacpan or search on metacpan
#   -return_status=>1  rather than exiting on failure, return status
#         return status values: 'logged out', 1, 'not logged in' 'login failed'
#         If we want that user gets a suggestion to use CAS to login, then
#         this option should not be used.
#
#   -header_no_print=> do not print header on success, but keep in $Header
sub _require_login_using_cas {
  my %args = @_; my $casurl = $args{-cas};
  my $header_no_print = $args{-header_no_print};
  my $retStatus;
  $retStatus = $args{-return_status} if exists($args{-return_status});
  my $title = "Login Page for Site: $SiteId";
  my $HTMLstart = "<HTML><HEAD><TITLE>$title</TITLE><BODY><h1>$title</h1>\n";
  my $casurl_r = "$casurl?r=".url();
  my $LoginMsg = "<p>Please use <a href=\"".encodeuri($casurl_r)."\">CAS</a> ".
    "to login.\n";

  &analyze_cookie;
  if ($SessionId ne '' && param('keywords') eq 'logout') {
    logout(); print header_delete_cookie();
    if ($retStatus) { return 'logged out' }
    print "<HTML><HEAD>";
    my $redirect;
    if ($args{-logout_redirect}) {
      $redirect = encodeuri($args{-logout_redirect});
      print "<meta http-equiv=\"Refresh\" content=\"2; URL=".
	"$redirect\">\n"; }
    my $t = $title; $t = $args{-logout_title} if $args{-logout_title};
    print "<TITLE>$t</TITLE><BODY>\n<H1>$t</H1>\n";
    print "<p>You are logged out.\n";
    if ($redirect) {
      print "<p>You are redirected to <a href=\"$redirect\">$redirect</a>.\n";
    } else { print $LoginMsg; }
    exit; }

  if ($SessionId ne '') {
    my $header = header();
    if ($header_no_print) { $Header=$header; return 1; }
    print $header; return 1; }

  my $request_type = param('request_type');
  if ($request_type ne 'Proceed') {
    if ($retStatus) { print header(); return 'not logged in' }
    print CGI::redirect(-uri=>$casurl_r);
    exit; }
  my $username = param('username'); my $stoken = param('stoken');
  if ($username eq '' or $stoken eq '') {
    print header(); if ($retStatus) { return 'not logged in' }
    print $HTMLstart, $LoginMsg; exit; }

  if ($casurl !~ /^https:\/\//i) {
    my $u = CGI::url(); $u=~ s/\/[^\/]+$//; $casurl = "$u/$casurl"; }

  require LWP::UserAgent; require HTTP::Request; require Mozilla::CA;
  my $ua = LWP::UserAgent->new();
  use HTTP::Request::Common qw(POST);
  my $req = POST $casurl, [ rt=>'verify', username=>$username, stoken=>$stoken ];
  my $resp = $ua->request($req);
  my $result = 'fail';
  if ($resp->is_success) {
    my $message = $resp->decoded_content; $message =~ s/\s//g;
    if ($message eq 'answer:ok') { $result = 'ok'; &_dbg383; }
    else { $Error.=" message=($message);" }
  } else {
    $Error.= "HTTP POST error code: ". $resp->code. "\n".
      "HTTP POST error message: ".$resp->message."\n";
  }
  if ($result ne 'ok') {
    $Error.="ERR-401:verify failed, result=($result) casurl=($casurl)\n";
    print header(); $LogReport.=$Error; &store_log;
    if ($retStatus) { return 'login failed'; }
    print $HTMLstart, "Unsuccessful login!\n"; exit; }
  my $u = ($AddAuthenticatedUser ? &get_user_by_userid_or_add($username) :
	   &get_user_unique('userid', $username));
  if ($u eq '') {
    $Error.="411-ERR: no userid ($username) in users.db\n";
    $LogReport.=$Error; &store_log;
    print header(); if ($retStatus) { return 'login failed'; }
    print $HTMLstart,
      "Unsuccessful login! (username not in users.db, ERR-414)\n";
    &store_log; exit; }
  $User = $u; &set_new_session($User);
  $LogReport.="User $UserEmail logged in.\n"; &store_log;
  print header_session_cookie(); return 1;
}

# Requires session (i.e., to be logged in).  Otherwise, makes redirection.
sub require_session {
  my %args=@_; my $defaultcgi = 'index.cgi';
  if (exists($args{-redirect}) && $args{-redirect} ne '' &&
      $args{-redirect} ne $ENV{SCRIPT_NAME})
  { $defaultcgi = $args{-redirect} }
  if (exists($args{-back}) && $args{-back}) {
    $defaultcgi.="?goto=$args{-back}";
  }
  &analyze_cookie;
  if ($SessionId eq '') {
    if ($ENV{SCRIPT_NAME} eq $defaultcgi) {
      print CGI::header(), CGI::start_html, CGI::h1("159-ERR:Login required");
      exit; }
    print CGI::redirect(-uri=>$defaultcgi); exit;
  }
}

# Prepare HTTP header. If SessionId is not empty, generate cookie with
# the sessionid and ticket.
sub header_session_cookie {
  my %args=@_; my $redirect=$args{-redirect};
  if ($redirect ne '') {
    if ($SessionId eq '') { return redirect(-uri=>$redirect) }
    else {
      return redirect(-uri=>$redirect,-cookie=>
		      cookie(-name=>$SiteId,
			     -value=>"$SessionId $Ticket"));
    }
  } else {
    if ($SessionId eq '') { return header } else
      { return header(-cookie=>cookie(-name=>$SiteId,
				      -value=>"$SessionId $Ticket")) }
  }
}
( run in 0.541 second using v1.01-cache-2.11-cpan-bbe5e583499 )