📄 auth.pl
字号:
# +--
#
# Add this simple authentication handler into the Pi3Web server using a line
# like:
#
# CheckAuth Pi3WebPerl File="../Pi3Perl/auth.pl" Init="init" Execute="execute" AuthFile="../Pi3Perl/users.txt"
#
# (Don't forget the include ../Conf/Pi3Perl.cnf at the top of the .pi3
# file!).
#
# Below is an example HTTP response that this handler causes the server to
# generate (some of the headers and all the body where generated by the
# configurated error action initiated by the Pi3::HTTPUtil_doHTTPError()
# function in this script):
# ___________<snip>____________
# HTTP/1.0 401 Unauthorized
# Server: Pi3Web/2.0
# Date: Tue, 14 Jul 2001 16:32:02 GMT
# WWW-Authenticate: Basic realm="perl-realm"
# Content-Type: text/html
# Pragma: no-cache
# Expires: Mon, 23 Feb 1970 15:30:00 GMT
# Last-Modified: Tue, 14 Jul 2001 16:32:02 GMT
#
#
# <HTML>
# <HEAD>
# <TITLE>
# Not Authorized
# </TITLE>
# </HEAD>
# <BODY BACKGROUND="/icons/Pi3Tile.gif" BGCOLOR="#FFFFFF">
# <H2>
# 401 Not Authorized
# </H2>
# You are not authorized to access the requested resource.
#
# <HR>
# Contact the site administrator <A HREF="mailto:webmaster@localhost"><I>webmaster
# @localhost</I></A>.
# </BODY>
# </HTML>
# ___________<snip>____________
#
# --+
my @Base64;
my @Plain;
sub BEGIN {
my ( $Base64 ) =
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
@Base64 = split / */, $Base64;
@Plain = (
-1, -1, -1, -1, -1, -1, -1 ,-1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 62, -1, -1, -1, 63,
52, 53, 54, 55, 56, 57, 58, 59, 60, 61, -1, -1, -1, 0, -1, -1,
-1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14,
15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, -1, -1, -1, -1, -1,
-1, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, -1, -1, -1, -1, -1
);
}
use strict;
use Pi3;
# +--
# Global configuration values
# --+
my $Realm;
my $AuthFile;
# +--
# Validate a user and password from the users (password) file.
# --+
sub validUser {
my( $username ) = shift;
my( $password ) = shift;
open INP, "<$AuthFile" || return 0;
foreach( <INP> )
{
next if /^\#.*/; # skip comments
my( $user, $pass, $realmlist ) = split( / /, $_, 3 ); # get username, password, realms
if ( $user =~ $username )
{
close INP;
my( @realms ) = split( /,/, $realmlist );
for(@realms) {
return 1 if (( $_ =~ $Realm ) && ( $pass =~ $password ));
};
return 0;
};
};
close INP;
return 0;
}
# +--
# Base64 encoding
# --+
sub Base64_encode {
my( @plain ) = split / */, shift;
my( $len ) = @plain + 0;
my( $result ) = "";
my( $state ) = 1;
my( $i ) = 0;
my( $iplain );
for( ;; )
{
my( $base64 );
my( $c ) = ( $i < $len ) ? ord(@plain[$i]) : 0 ;
if ( $state =~ 1 )
{
if ( $i >= $len ) { return $result; };
$base64 = ( $c >> 2 );
$iplain = ( $c << 4 ) & 0x30;
$i++;
$state = 2;
}
elsif ( $state =~ 2 )
{
$base64 = $iplain | ( $c >> 4 );
$iplain = ( $c << 2 ) & 0x3C;
$i++;
$state = 3;
}
elsif ( $state =~ 3 )
{
$base64 = $iplain | ( $c >> 6 );
$iplain = $c & 0x3F;
$i++;
$state = 4;
}
elsif ( $state =~ 4 )
{
$base64 = $iplain;
$state = 1;
};
$result .= @Base64[$base64 & 0x3F];
if ( $i > $len )
{
if ( $state =~ 2 )
{ return $result."==="; }
elsif ( $state =~ 3 )
{ return $result."=="; }
elsif ( $state =~ 4 )
{ return $result."="; }
};
};
return $result;
}
# +--
# Base64 decoding
# --+
sub Base64_decode {
my( @pbase64 ) = split / */, shift;
my( $ilen ) = @pbase64 + 0;
my( $estate ) = 1;
my( $idone ) = 0;
my( $i );
my( $result ) = "";
my( $ilast );
for( $i=0; $i<$ilen; $i++)
{
my( $c ) = @pbase64[$i];
$_ = $c;
last if ( !/[0-9a-zA-Z]/ && !/\+/ && !/\// );
my( $iplain ) = $Plain[ord($c)];
die( "assertion failure!" ) if $iplain =~ -1;
if ( $estate =~ 1 )
{
$ilast = ( $iplain << 2 ) & 0xFC;
$estate = 2;
}
elsif ( $estate =~ 2 )
{
$result = $result.chr( $ilast | ( ($iplain >> 4 ) & 0x03) );
$ilast = ( $iplain << 4 ) & 0xF0;
$estate = 4;
}
elsif ( $estate =~ 4 )
{
$result = $result.chr( $ilast | ( ($iplain >> 2 ) & 0x0F) );
$ilast = ( $iplain << 6 ) & 0xC0;
$estate = 6;
}
elsif ( $estate =~ 6 )
{
$result = $result.chr( $ilast | ( $iplain & 0x3F) );
$estate = 1;
};
$_ = $c;
last if /=/;
};
return $result;
};
# +--
#
# Initialize function to setup global variables with values from
# pi3 configuration file, i.e. Password file and realm name.
#
# ** NOTE ** In this implementation all perl based handlers appear to
# share the name global namespace, so multiple perl authentication handlers
# will clobber each others global data.
#
# --+
sub init {
my( $obj ) = shift;
my( $db );
$db = Pi3::PIObject_getDB( $obj );
$Realm = Pi3::PIDB_lookup( $db, &Pi3::PIDBTYPE_RFC822, "Realm",
&Pi3::PIDBFLAG_NONE );
$AuthFile = Pi3::PIDB_lookup( $db, &Pi3::PIDBTYPE_RFC822, "AuthFile",
&Pi3::PIDBFLAG_NONE );
return &Pi3::PIAPI_COMPLETED;
}
# +--
#
# Function which is invoked to authenticate HTTP request using basic
# authentication. Usernames and passwords are read from a file.
#
# --+
sub execute {
my( $obj ) = shift;
my( $pihttp ) = shift;
my( $piiobuf ) = shift;
my( $response_db );
my( $request_db );
$request_db = Pi3::PIHTTP_getDB( $pihttp, &Pi3::GETDB_REQUEST );
$response_db = Pi3::PIHTTP_getDB( $pihttp, &Pi3::GETDB_RESPONSE );
#
# Lookup the realm set in the 'AuthenticationRealm' string variable
# of the response DB
#
$_ = "";
my( $authrealm );
$authrealm = Pi3::PIDB_lookup( $response_db, &Pi3::PIDBTYPE_STRING,
"AuthenticationRealm", &Pi3::PIDBFLAG_NONE );
$_ = $authrealm;
if ( ( length( $_ ) != 0 ) && !( $_ =~ $Realm ) )
{
#
# This authentication handler does not apply
#
return &Pi3::PIAPI_CONTINUE;
};
#
# Get browser authentication string from the rfc822 request
# header
#
my( $authorization ) = "";
$authorization = Pi3::PIDB_lookup( $request_db, &Pi3::PIDBTYPE_RFC822,
"Authorization", &Pi3::PIDBFLAG_NONE );
$_ = $authorization;
if ( /^Basic .*/ )
{
s/^Basic (.*)/$1/;
my( $username, $password ) = split( /:/, Base64_decode( $_ ), 2 );
if ( validUser( $username, $password) )
{
return &Pi3::PIAPI_COMPLETED;
};
#
# Otherwise fall through to challenge the authentication.
#
};
#
# Challenge the authentication
#
Pi3::PIDB_replace( $response_db, &Pi3::PIDBTYPE_STRING, "AuthType",
"Basic", &Pi3::PIDBFLAG_NONE );
Pi3::PIDB_replace( $response_db, &Pi3::PIDBTYPE_RFC822,
"WWW-Authenticate", 'Basic realm="'.$Realm.'"', 0 );
#
# Redirect because of authentication failure
#
Pi3::HTTPUtil_doHTTPError( $pihttp, &Pi3::ST_UNAUTHORIZED );
return 1; # INT_REDIRECT
}
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -