CGI-Auth
view release on metacpan or search on metacpan
</head>
<body>
<p>Please enter your login information:</p>
DEFAULT
}
if ($msg)
{
print qq(<p style="color: red; font-weight: bold;">$msg</p>\n);
}
my $formaction = $self->{formaction};
print <<START;
<form method=post action="$formaction">
<table border=0>
START
print $self->FormFields;
# Print form for filling in auth fields.
foreach my $authfield (@{$self->{authfields}})
{
if ($authfield->{required})
{
if ($authfield->{hidden})
{
print "<tr><td align=left><p><b>", $authfield->{display}, ":</b></p></td>",
"<td align=left><p><input type=password name=auth_", $authfield->{id}, "></p></td>\n";
}
else
{
print "<tr><td align=left><p><b>", $authfield->{display}, ":</b></p></td>",
"<td align=left><p><input type=text name=auth_", $authfield->{id}, "></p></td>\n";
}
}
}
print <<END;
</table>
<p><input type=submit name="auth_submit" value="Login"></p>
</form>
END
if (open FOOTER, "< " . $self->{loginfooter})
{
my @footer = <FOOTER>;
close FOOTER;
print @footer;
}
else
{
print "</body></html>\n";
}
}
=pod
=item C<FormFields>
Returns HTML code for placing existing CGI parameters on a form so that the
login process is transparent to the calling script.
For any single-valued parameters, it creates a hidden C<< <input> >> control,
and for any multi-valued parameters, it creates a hidden (i.e.,
C<style="display: none">) C<< <select> >> control with all of its values.
=cut
sub FormFields
{
my ($self) = shift;
my $formfields = '';
for my $name ($self->{cgi}->param)
{
next if ($name =~ /^auth_/);
my @values = $self->{cgi}->param($name);
if (@values < 2) # i.e., 0 or 1 values.
{
my $val = $values[0] || '';
$formfields .= qq(<input type=hidden name="$name" value="$val">\n);
}
else
{
$formfields .= join ("\n",
qq(<select multiple name="$name" style="display:none">),
(map {qq(<option selected value="$_" style="display:none">$_</option>)} @values),
qq(</select>),
'' # For a \n at the end.
);
}
}
return $formfields;
}
=pod
=item C<CreateSessionFile>
Creates a session file in the session file directory.
=cut
sub CreateSessionFile
{
my ($self, $field0) = @_;
my @chars = (0..9, 'A'..'Z');
my $sessfilename;
# Verify format and untaint.
my $env_ra = $ENV{REMOTE_ADDR} || '';
$env_ra =~ /([\dA-F\.:]+)/; # IPv4 or IPv6 address.
my $remoteaddr = $1 || '';
do
{
$sessfilename = join '', map {$chars[rand 36]} (1..12);
( run in 1.653 second using v1.01-cache-2.11-cpan-39bf76dae61 )