view release on metacpan or  search on metacpan

Wyrd/Services/Auth.pm  view on Meta::CPAN

	
	#We have determined at this point that the user has no prior authorization, but that
	#cookies are enabled and they could be authorized.

	#require an SSL login server if this is an insecure port (currently always).
	#in future, 1 will be replaced with a test for SSL encryption.
	if (($ENV{'HTTPS'} ne 'on') or $force_login_server) {

		#Get an encryption key and a ticket number
		my ($key, $ticket) = $self->generate_ticket;

		#Send that pair to the Login Server
		$key_url = 'https://' . $req->hostname . $key_url unless ($key_url =~ /^https?:\/\//i);
		if ($key_url =~ /^https:\/\//i) {
			eval('use IO::Socket::SSL');
			die "LWP::UserAgent needs to support SSL to use a login server over https.  Install IO::Socket::SSL and make sure it works."
				if ($@);
		}
		my $ua = LWP::UserAgent->new;
		$ua->timeout(60);
		my $response = $ua->request(POST $key_url,
			[
				key		=>	$key,
				ticket	=>	$ticket
			]
		);
		my $status = $response->status_line;

		#If the key can't be saved on the login server, send regrets and close
		if ($status !~ /200|OK/) {
			if ($status =~ /Invalid argument/i) {
				$debug && warn ("You may need to Update IO::Socket::SSL");
			} else {
				$debug && warn ("Login Server status was $status");
			}
			my $failed_url = $req->dir_config('LSDownURL');
			$failed_url = $scheme . '://' . $req->hostname . $port . $failed_url unless ($failed_url =~ /^http/i);
			if ($failed_url) {
				$req->custom_response(REDIRECT, $failed_url);
				return REDIRECT;
			} else {
				return HTTP_SERVICE_UNAVAILABLE;
			}

		#Send the encrypted data as a lookup key to the login form to add
		#to its hidden fields.  If a challenge failed earlier in the script
		#and ReturnError is defined, use it.
		} else {
			my $use_error = $req->dir_config('ReturnError');
			my $login_url = $req->dir_config('LoginFormURL');
			$login_url = $scheme . '://' . $req->hostname . $port . $login_url unless ($login_url =~ /^http/i);
			my $ls_url = $req->dir_config('LSLoginURL');
			$ls_url = $scheme . '://' . $req->hostname . $port . $ls_url unless ($ls_url =~ /^http/i);
			if ($login_url) {
				my $uri = $req->uri;
				$uri = Apache::URI->parse($uri);
				my $query_string = $uri->query;
				$query_string =~ s/\&?check_cookie=yes\&?//;
				$query_string =~ s/challenge=[0123456789abcdefABCDEF:]+\&?//g;
				$query_string = '?' . $query_string if ($query_string);
				my $on_success = Apache::Util::escape_uri(encode_base64($scheme . '://' . $req->hostname . $port . $req->uri . $query_string));
				my $redirect = $login_url .
					'?ls=' . $ls_url .
					'&ticket=' . $ticket .
					'&on_success=' . $on_success .
					'&use_error=' . $use_error .
					($challenge_failed ? '&'. $use_error . '=' . $challenge_failed : '');
				$debug && warn('Need a login, with redirect going to ' . $redirect);
				$req->custom_response(REDIRECT, $redirect);
				return REDIRECT;
			} else {
				die "Must define LoginFormURL in Apache Config to use Apache::Wyrd::Services::Auth";
			}
		}

	#Since we are using SSL, we can accept login information as normal CGI params.
	} else {
		my $username = $apr->param('username');
		my $password = $apr->param('password');
		my $login_failed = '';
		if ($username) {
			my $user = $self->initialize({username => $username, password => $password});
			if ($user->login_ok) {
				$self->authorize_user($req, $user);
				my $uri = $req->uri;
				$uri = Apache::URI->parse($uri);
				my $redirect = $scheme . '://' . $req->hostname . $port . $req->uri . '?check_cookie=yes';
				$debug && warn('Setting a cookie, with redirect going to ' . $redirect);
				$req->custom_response(REDIRECT, $redirect);
				return REDIRECT;
			}
			$login_failed = 'Login failed.  Please check your username and password.';
			$debug && warn('Login failed.');
		} else {
			$debug && warn('Login was not provided.');
		}
		my $use_error = $req->dir_config('ReturnError');
		my $login_url = $req->dir_config('LoginFormURL');
		$login_url = $scheme . '://' . $req->hostname . $port . $login_url unless ($login_url =~ /^http/i);
		my $ls_url = $scheme . '://' . $req->hostname . $port . $req->uri;
		if ($login_url) {
			my $uri = $req->uri;
			$uri = Apache::URI->parse($uri);
			my $on_success = Apache::Util::escape_uri(encode_base64($scheme . '://' . $req->hostname . $port . $req->uri));
			my $redirect = $login_url .
				'?ls=' . $ls_url .
				'&on_success=' . $on_success .
				'&use_error=' . $use_error.
				($login_failed ? '&'. $use_error . '=' . $login_failed : '');
			$debug && warn('Need a login, with redirect going to ' . $redirect);
			$req->custom_response(REDIRECT, $redirect);
			return REDIRECT;
		} else {
			die "Must define LoginFormURL in Apache Config to use Apache::Wyrd::Services::Auth";
		}
	}
}

sub revive {
	my ($self, $user_info) = @_;
	my $user = undef;
	my $user_object = $self->{'user_object'};
	my $debug =  $self->{'debug'};
	eval "use $user_object";
	$debug && $@ && die("$user_object failed to be initialized: $@");
	#TO DO: place this into a safe of some sort
	eval('$user = ' . $user_object . '->revive($user_info)');
	return $user;

}

sub initialize {
	my ($self, $init) = @_;
	my $user = undef;
	my $username=$init->{'username'};
	my $password=$init->{'password'};
	my $user_object = $self->{'user_object'};
	eval "use $user_object;";
	eval('$user = ' . $user_object . '->new({username => $username, password => $password})');
	die $@ if ($@);
	return $user;
}

sub generate_ticket {
	my ($self) = @_;

	my $debug = $self->{'debug'};
	my $ticketfile = $self->{'ticketfile'};

	# 1) Generate a random 56-byte key.  NB: values are 1-255, not 0-255 as it will be stored in A DB file, so null byte terminates string in C.  Avoid it.
	my $key = '';
	for (my $i=0; $i<56; $i++) {
		$key .= chr(int(rand(255)) + 1);
	}
	
	# 2) Make a ticket serial number by using sha256
	my $ticket = sha256_hex($key);
	$key = Apache::Util::escape_uri($key);

	$debug && warn ("Storing key under ID $ticket");
	my $pad = Apache::Wyrd::Services::TicketPad->new($ticketfile);
	$pad->add_ticket($ticket, $key);

	return ($key, $ticket);
}

sub decrypt_challenge {
	my ($self, $challenge) = @_;

	my $debug = $self->{'debug'};
	my $ticketfile = $self->{'ticketfile'};

	#separate the ticket from the data
	my ($ticket, $data) = split ':', $challenge;

	#find the key for decrypting the data;
	$debug && warn('finding ' . $ticket);
	my $pad = Apache::Wyrd::Services::TicketPad->new($ticketfile);
	my $key = $pad->find($ticket);

	$debug && warn "found key $key";
	$key = Apache::Util::unescape_uri($key);
	my $cr = Apache::Wyrd::Services::CodeRing->new({key => $key});
	my ($username, $password) = split ("\t", ${$cr->decrypt(\$data)});

	return ($username, $password);
}

sub authorize_user {
	my ($self, $req, $user) = @_;

	my $debug = $self->{'debug'};
	my $cr = Apache::Wyrd::Services::CodeRing->new;
	my $auth_path = $req->dir_config('AuthPath');

	$debug && warn ("User has been authenticated. Authorizing User and creating Cookie");

	my $user_info = $user->store;
	$debug && warn ("User info is:\n$user_info");
	$req->notes->add('User' => $user_info);
	$user_info = $cr->encrypt(\$user_info);
	my $ip_addr = $req->connection->remote_ip;
	$ip_addr = $cr->encrypt(\$ip_addr);
	my $cookie = Apache::Wyrd::Cookie->new(
		$req,
		-name=>'auth_cookie',
		-value=>$$ip_addr . ':' . $$user_info,
		-domain=>$req->hostname,
		-path=> ($auth_path || '/')
	);
	$cookie->bake;
}

=pod

=back

=head2 PERLSETVAR DIRECTIVES

=over

=item LoginFormURL

Form URL (required)

=item UserObject

Module for the User object which performs authorization (required).  See
the C<Apache::Wyrd::User> module.

=item NoCookieURL

URL to send cookie-less browsers to (required)

=item ReturnError

Send error back to the Login URL via the given variable (optional)

=item LSKeyURL

Login Server URL for key (required when a Login Server is being used)