view release on metacpan or  search on metacpan

lib/Authen/Ticket/Client.pm  view on Meta::CPAN

# ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.

package Authen::Ticket::Client;

use strict;

use vars (qw/$VERSION %DEFAULTS @ISA/);

use MIME::Base64 (qw/decode_base64/);

use Carp;

if($ENV{MOD_PERL}) {
  @ISA = (qw/Apache/);
} else {
  @ISA = ( );
}

$VERSION = '0.02';

%DEFAULTS = (
  TicketDomain => undef,
  TicketName   => 'ticket',
);

sub debug {
  my $self = shift;

  if($$self{_log}) {
    $$self{_log}->debug(join($,,@_));
  } elsif($$self{DEBUG}) {
    carp join($,,@_);
  }
}

sub new {
  my $class = shift;
  $class = ref($class) || $class;
  my $r;
  my $self = { };
  my $cookies;

  bless $self, $class;

  if($ENV{MOD_PERL}) {
    $r = shift;
    unless(ref $r) {
      unshift @_, $r;
      $r = '';
    }
    $r ||= Apache->request;
    $self->{_r} = $r;
    $self->{_log} = $r->log;
    $cookies = $r->headers_in->{Cookie};
  } else {
    $cookies = $ENV{HTTP_COOKIE};
  }

  my @cookies = split(/;\s*/, $cookies);

  $self->configure(@_);

  $self->initialize;

  $self->debug("Getting ticket: $$self{TicketName}");
  my $ticket;
  my $ticket_name = $$self{TicketName};

  while(@cookies && !$ticket) {
    my $t = shift @cookies;
    $self->debug("Considering [$t]");
    my($k, $v) = split(/=/, $t, 2);
    $k =~ s{%(..)}{chr(hex($1))}ge;
    $self->debug("$k => [$v]");
    next unless $k eq $$self{TicketName};
    $v =~ s{%(..)}{chr(hex($1))}ge;
    $ticket = $v;
  }

  $self->debug("Cookies: [$cookies]");
  $self->debug("Ticket: [$ticket]");
  
  #
  # provide automatic signature verification if available...
  #
  $self->debug("Ticket: [$ticket]");
  my $sc = eval { $self->verify_ticket($ticket); };
  if($@) {
    $self->debug("Eval results: [$@]");
  } else {
    $ticket = $sc;
    $self->debug("Verified ticket: [$sc]");
  }
  $self->debug("Ticket now: [$ticket]");

  $self->{ticket} = $self->deconstruct_cookie(
                      $self->decode_cookie(
                        ref($ticket) ? join('', @{ $ticket })
                                     : $ticket
                      )
                    );

  return $self
}

sub configure {
  my $self = shift;
  my %opts = (@_);

  # build options hash
  my %defaults = ( );
  my @classes = ( );
  my %classes_seen = ( );

  push @classes, (ref $self or $self);

  while(@classes) {
    no strict;
    my $class = shift @classes;
    next if $classes_seen{$class};
    $classes_seen{$class}++;
    push @classes, @{ "$class\::ISA" };
 

    if(defined %{ "$class\::DEFAULTS" }) {
      foreach my $k ( keys %{ "$class\::DEFAULTS" } ) {
        $defaults{$k} ||= ${ "$class\::DEFAULTS" }{$k};
      }
    } 
  } 
  
  if($$self{_r}) {
    foreach my $k (keys %defaults) {
      $self->{$k} = $self->dir_config($k);
    }
 
    unless($self->{TicketDomain}) {
      $$self{TicketDomain} = $self->server->server_hostname;
      $$self{TicketDomain} =~ s/^[^.]+//;
    }