view release on metacpan or  search on metacpan

lib/Authen/ModAuthPubTkt.pm  view on Meta::CPAN

## On unix, assume it's on the $PATH.
## On Windows - you're on your own.
## TODO: make this user-configurable.
my $openssl_bin = "openssl";

=pod

=head1 METHODS

=head2 pubtkt_generate

Generates a signed ticket.

If successful, returns a signed ticket string (to be sent back to the user as a cookie).

On any failure (bad key, failure to run C<openssl>, etc.) returns C<undef>.

Accepts a hash of parameters:

=over 4

=item B<privatekey>

String containing the private key filename (full path). The key can be either DSA or RSA key (see B<keytype>).

=item B<keytype>

either "rsa" or "dsa" - depending on how you created the private/public key files.

=item B<userid>

String containing the user ID. No specific format is enforced: can by a number, a string, an email address, etc. It will be encoded as "uid=XXXX" in the signed ticket.

=item B<validuntil>

Numeric value, containing the validity period, in seconds since epoch (use C<time()> function).

=item B<graceperiod>

Optional. Numeric value. If given, will be added to the signed ticket string.

=item B<clientip>

Optional. A string with an IP address. If given. will be added to the signed ticket string.

=item B<token>

Optional. Any textual string. If given. will be added to the signed ticket string.

=item B<userdata>

Optional. Any textual string. If given. will be added to the signed ticket string.

=back

=cut
sub pubtkt_generate
{
	my %args = @_;
	my $private_key_file = $args{privatekey} or croak "Missing \"privatekey\" parameter";
	croak "Invalid \"privatekey\" value ($private_key_file): file doesn't exist/not readable"
		unless -r $private_key_file;

	my $keytype = $args{keytype} or croak "Missing \"keytype\" parameter";
	croak "Invalid \"keytype\" value ($keytype): expecting 'dsa' or 'rsa'\n"
		unless $keytype eq "dsa" || $keytype eq "rsa";

	my $user_id = $args{userid} or croak "Missing \"userid\" parameter";

	my $valid_until = $args{validuntil} or croak "Missing \"validuntil\" parameter";
	croak "Invalid \"validuntil\" value ($valid_until), expecting a numeric value."
		unless $valid_until =~ /^\d+$/;

	my $grace_period = $args{graceperiod} || "";
	croak "Invalid \"graceperiod\" value ($grace_period), expecting a numeric value."
		unless $grace_period eq "" || $grace_period =~ /^\d+$/;

	my $client_ip = $args{clientip} || "";
	##TODO: better IP address validation
	croak "Invalid \"client_ip\" value ($client_ip), expecting a valid IP address."
		unless $client_ip eq "" || $client_ip =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/;

	my $tokens = $args{token} || "";
	my $user_data = $args{userdata} || "";

	# Generate Ticket String
	my $tkt = "uid=$user_id;" ;
	$tkt .= "cip=$client_ip;" if $client_ip;
	$tkt .= "validuntil=$valid_until;";
	$tkt .= "graceperiod=" . ($valid_until - $grace_period) . ";" if $grace_period;
	$tkt .= "tokens=$tokens;";
	$tkt .= "udata=$user_data";

	my $algorithm_param  = ( $keytype eq "dsa" ) ? "-dss1" : "-sha1";

	my @cmd = ( $openssl_bin,
		    "dgst", $algorithm_param,
		    "-binary",
		    "-sign", $private_key_file ) ;

	my ($stdin, $stdout, $stderr);

	$stdin = $tkt;
	run3 \@cmd, \$stdin, \$stdout, \$stderr;
	my $exitcode = $?;

	if ($exitcode != 0) {
		warn "pubtkt_generate failed: openssl returned exit code $exitcode, stderr = $stderr\n";
		return;
	}

	$tkt .= ";sig=" . encode_base64($stdout,""); #2nd param = no EOL.

	return $tkt;
}

=head2 pubtkt_verify

Verifies a signed ticket string.

If successful (i.e. the ticket's signature is valid), returns TRUE (=1).

On any failure (bad key, failure to run C<openssl>, etc.) returns C<undef>.

B<NOTE>: B<This function checks ONLY THE SIGNATURE, based on the public key file. It is the caller's resposibility to check the expiration date.>  That is: The function will return TRUE if the ticket is properly signed, but possibly expired.

Accepts a hash of parameters:

=over 4

=item B<publickey>

String containing the public key filename (full path). The key can be either DSA or RSA key (see B<keytype>).

=item B<keytype>

either "rsa" or "dsa" - depending on how you created the private/public key files.

=item B<ticket>

The string of the ticket (such as returned by C<pubtkt_generate>).

=back

=cut
sub pubtkt_verify
{
	my %args = @_;
	my $public_key_file = $args{publickey} or croak "Missing \"publickey\" parameter";
	croak "Invalid \"publickey\" value ($public_key_file): file doesn't exist/not readable"
		unless -r $public_key_file;

	my $keytype = $args{keytype} or croak "Missing \"keytype\" parameter";
	croak "Invalid \"keytype\" value ($keytype): expecting 'dsa' or 'rsa'\n"
		unless $keytype eq "dsa" || $keytype eq "rsa";
	my $algorithm_param  = ( $keytype eq "dsa" ) ? "-dss1" : "-sha1";

	my $ticket_str = $args{ticket} or croak "Missing \"ticket\" parameter";