view release on metacpan or  search on metacpan

SecSess/Cookie.pm  view on Meta::CPAN

	if ($params->{secure}) { $cookie .= "; secure"; }

	## remaining parameters (domain, expires, ... )
	for $par (keys %{$params}) {
		next if $par eq 'path';
		next if $par eq 'secure';
		$cookie .= sprintf("; %s=%s", $par, $params->{$par});
	}
  
	return $cookie;
}

## verify an administration request
# Note: this is currently implemented as a CGI like GET then POST form.
sub verifyAdminRequest {
	my $self = shift;
	my($r) = @_;
	my $log = $r->log;
	my($uid, $form, %args, $newuid, $pw, $status, $msg);

    $log->debug(ref($self), "->verifyAdminRequest():");

	## is the user really an admin?
	unless ($uid = $r->user) { return 'No user ID provided from authen.'; }
	unless ($self->{dbo}->is_administrator($uid)) {
		return {
			message => "User '$uid' is not an administrator.",
			forbidden => 'true'
		};
	}

	## is this the initial visit to the form?
	unless ($r->method eq 'POST') { 
		return {
			message => 'Initial visit to login form.',
			fill_form => 'true'
		};
	}

	## read args and bail if something is inconsistent
	$form = $self->adminURL;
	%args = $r->content;
	$newuid = $args{newuid};
	$pw = $args{pw};
	unless ($newuid && $pw) { # empty
		return {
			message => 'Some items were empty in form.',
			uri => "$form?msg=empty",
		};
	}

	## check if *new* user is valid
	$status = $self->{dbo}->get_user_status($newuid);
	unless ($status eq 'enabled') {
		return {
			message => "User '$newuid' unavailable: '$status'.",
			uri => "$form?msg=$status"
		};
	}
	
	## validate super user's password
	$msg = $self->{dbo}->validate_user_pass($uid, $pw);
	unless ($msg eq 'OK') {
		return {
			message => "Incorrect superuser password for '$uid'.",
			uri => "$form?msg=$msg"
		};
	}
	
	## everything looks good, allow the change of identity
	return {
		message => "Superuser '$uid' changing to user '$newuid'",
		newuid => $newuid
	};
}

1;

__END__
What are you looking at?