view release on metacpan or  search on metacpan

lib/Authen/Ticket/Server.pm  view on Meta::CPAN

  my $query = $$self{query};
  my $stdout = $$self{stdout};
  my $string = join($,, @_);

  $stdout->print(
    $query->header(),
    $self->no_cookie_error_message($string)
  );
  CGI::WeT->show_page if defined $CGI::WeT::VERSION;
}

sub no_cookie_error_message {
  my $self = shift;
  my $q = $$self{query};
  my $s = shift;

  return (
    $q->start_html(-title => 'Unable to Log In', -bgcolor => 'white'),
    $q->h1('Unable to Log In'),
    "This site uses cookies for its own security.  Your browser must ",
    "be capable of processing cookies ", $q->em('and'), " cookies must be ",
    "activated.  Please set your browser to accept cookies, then press ",
    "the ", $q->strong('reload'), " button.", $q->hr ,
    $q->end_html
  );
}

sub no_user_password_error {
  my $self = shift;
  my $query = $$self{query};
  my $stdout = $$self{stdout};
  my $request_uri = $$self{request_uri};
  my $string = join($,, @_);

  $stdout->print(
    $query->header,
    $self->no_user_password_error_message($string)
  );
  CGI::WeT->show_page if defined $CGI::WeT::VERSION;
}

sub no_user_password_error_message {
  my $self = shift;
  my $q = $$self{query};
  my $rq = $$self{request_uri};
  my $s = shift;

  my $v =
    $q->start_html(-title => 'Log In', -bgcolor => 'white') .
    $q->h1('Please Log In');
  $v .= $q->h2($q->font({color => 'red'}, "Error: $s")) if $s;
  $v .= $q->start_form(-action => $q->script_name) .
        $q->table(
          $q->Tr($q->td(['Name',     $q->textfield(-name => 'user')])),
          $q->Tr($q->td(['Password', $q->password_field(-name => 'password')])),
          $q->Tr($q->td(['Duration', $q->textfield(-name => 'duration',
                                                   -default =>
                     ($$self{TicketExpires} || 900) / 60,
                                                   -size => '4') .
                                                        ' minutes'])),
          $q->Tr($q->td(['Security', $q->popup_menu(
                           -name => 'security',
                           '-values' => [qw(strong med weak)],
                           -default => 'strong',
                           -labels => {qw(strong Strong med Medium weak Weak)},
                         ) ] ) )
        ) .
        $q->hidden(-name => 'request_uri', -value => $rq) .
        $q->submit('Log In') .
        $q->end_form . $q->em('N.B.:');
  $v .= <<1HERE1;
You must set your browser to accept cookies in order for login 
to succeed.  You will be asked to log in again after some period 
of time has elapsed.
<p>
Strong security is recommended for any browser not using a proxy.  Weak 
security is only recommended when the browser is going through different 
proxies on different networks.  Use the strongest security that will allow 
access.
</p>
1HERE1

  return $v;
}

sub get_userinfo {
  my $self = shift;
  my $q = $$self{query};

  my $u = { };

  foreach my $k (qw/user password duration security/) {
    $u->{$k} = $q->param($k);  
  }  
  
  return $u;
}

sub authenticate {
  my $self = shift;
  my $userinfo = shift;

  my $class = ref $self || $self;
  if($$self{_r}) {
    $self->log->warn("$class\->authenticate is undefined");
  } else {
    carp "$class\->authenticate is undefined";
  }

  return undef;
}

sub _quote_value {
  my $v = shift;
  $v =~ s{"}{\\"}g;
  if($v =~ /\s|[,]/) {
    return "\"$v\"";
  } else {
    return $v;
  }
}