package OX::Session;
#
# $Id: Session.pm,v 1.2 2005/08/02 21:34:56 martin Exp $
#
# Copyright (c) 2005 Martin Werthmoeller <mw@werthmoeller.de>
#

use strict;
use Carp;

=head1 NAME OX:Session - Open-Xchange session data

Session

=head1 SYNOPSIS

    use C<OX::Session>;
    $OXs = new OX::Session($login,$password,$language,$clientip,$host,$sid);


=head1 DESCRIPTION

  An object of the OX::Session class holds the data of a open-xchange
  session. The object holds the following parameters:

    'login'    => login name of the user
    'password' => cleartext(!) password of the user
    'language' => choosen language for this session
    'clientip' => ip address of the client
    'hostname' => the hostname of the open-xchange session server
    'sid'      => the session id
    'weburi'   => the uri to access the open-xchange web interface

=head1 METHODS

=head2 new($login,$password,$language,$clientip,$host,$sid)

  The constructor of an OX::Session object.

=cut
sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my ($login,$password,$language,$clientip,$host,$sid) = @_;

    my $self = { 'login'    => $login,
                 'password' => $password,
                 'language' => $language,
                 'clientip' => $clientip,
                 'hostname' => $host,
                 'sid'      => $sid,
               };
    bless $self, $class;
    $self->{'weburi'} = 'http://' . $self->{'hostname'} . 'servlet/intranet?SITE=beforeAuth&sessionID=' . $self->{'sid'};

    return undef unless $sid;
    return $self;
}


### EOP ###
1;


########################################################################
package OX::SessionD;

use strict;
use Carp;
use IO::Socket::INET;
use MIME::Base64 ();
use Digest::MD5  qw(md5_hex);


=head1 NAME OX:SessionD - Access the Open-Xchange session daemon

Session

=head1 SYNOPSIS

    use C<OX::SessionD>;
    $OXd = new OX::SessionD( 'host' => 'localhost', 'port' => 33333)


=head1 DESCRIPTION

=head1 METHODS

=head2 new([%params])

 Constructor of the OX::SessionD class. The optional %params hash
 contains the host (host =>)and port (port =>) parameters and will be
 set to the default values 'localhost' and '33333'.

=cut
sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my (%params) = @_;

    my $self = { 'host' => $params{'host'} || 'localhost',
                 'port' => $params{'port'} ||  33333};
    bless $self, $class;
    return $self;
}


=head2 getSessions()

  Returns a hash array ( 'sid' => $obj ) with OX::Session objects.

=cut
sub getSessions
{
    my $self = shift;
    my $slist = {};

    my $query = 'getsessions: '.MIME::Base64::encode('authdata');
    my $data = $self->_queryDaemon($query);
    # $data contains an array ref with lines

    foreach my $line (@{$data}) {
        # format "sessionID uid\x01pass\x01\lang\x01clientip\x01host"
        my ($sid,$str) = split /\s+/, $line;

        my ($uid,$pass,$lang,$clientip,$host) =
            split /\x01/, MIME::Base64::decode($str);
        # the session daemon delivers gargabe at end
        next unless $uid;

        $slist->{$sid} = new OX::Session($uid,$pass,$lang,$clientip,$host,$sid);
    }
    return $slist;
}


=head2 checkUser($uid)

  Checks if the user with $uid exists. Returns a true value if
  successful.

=cut
sub checkUser
{
    my $self = shift;
    my $uid  = shift;

    if ($self->_queryDaemon('checkuser: '.$uid)) {
        return 1;
    }
    else {
        return undef;
    }
}


=head2 report()

  Forces the session daemon to write session data to logfile. Returns
  a true value if successful.

=cut
sub report
{
    my $self = shift;
    if ($self->_queryDaemon('report:')) {
        return 1;
    }
    else {
        return undef;
    }
}

=head2 login($login,$passwd,$remoteip,$hostname,$lang)

  This method performs an authentication request. If successful an
  openexchange session will be established. If successful, a
  OX::Session object will be returned, otherwise undef.

  The parameters are:

     uid      - user id
     passwd   - password (cleartext)
     remoteip - ip address of the clients host
     hostname - name of the virtual host
     lang     - language (default: DE)

  Returns a OX::Session object.

=cut
sub login
{
    my $self = shift;
    my ($login,$passwd,$remoteip,$hostname,$lang) = @_;
    $lang = 'DE' unless $lang;
    my $query = MIME::Base64::encode( $login."\x01".
                                      $passwd."\x01".
                                      $lang."\x01".
                                      $remoteip."\x01".
                                      $hostname);
    $query =~ s/\n//g;
    my $rand = rand((time)*$$);
    my $sid = md5_hex($rand.$remoteip);
    #my $timestamp = timelocal(localtime());
    my $timestamp = time();
    if ($self->_queryDaemon("add: $timestamp 3600 $sid $query")) {
        return new OX::Session($login,$passwd,$lang,$remoteip,$hostname,$sid);
    }
    else {
        return undef;
    }
}


=head2 getSession($sid)

   Loads the data of the session assigned to $sid. Returns the
   OX::Session object.

=cut
sub getSession
{
    my $self = shift;
    my $sid  = shift;

    my $data = $self->_queryDaemon("getauth: $sid");
    if ($data) {
        my ($uid,$pass,$lang,$clientip,$host) =
            split /\x01/, MIME::Base64::decode($data->[0]);
        return new OX::Session($uid,$pass,$lang,$clientip,$host,$sid);
    }
    else {
        return undef;
    }
}


=head2 ping($sid)

  Resets the timeout of the OX session with the given session
  id. Returns a true value if successful.

=cut
sub ping
{
    my $self = shift;
    my $sid  = shift;

    if ($self->_queryDaemon('ping: '.$sid)) {
        return 1;
    }
    else {
        return undef;
    }
}


=head2 logoff($sid)

  Stopps the current session (logoff). Returns a truve value if
  successful.

=cut
sub logoff
{
    my $self = shift;
    my $sid  = shift;

    if ($sid && $self->_queryDaemon('clear: '.$sid)) {
        return 1;
    }
    else {
        return undef;
    }
}




## query the session daemon and return an array reference with the
## results.
sub _queryDaemon {
    my $self  = shift;
    my $query = shift;
    my $resp = [];

    my $Socket = IO::Socket::INET->new( 'PeerAddr' => $self->{'host'},
                                        'PeerPort' => $self->{'port'},
                                        'Proto'    => 'tcp',
                                      )
        or croak("Cannot open socket: $!");

    $Socket->autoflush(1);        # default at IO::Socket 1.18 or newer
    chomp($query);
    $query .= "\0";

	print $Socket $query;
    foreach my $line (<$Socket>) {
        if ($line =~ /ERROR/) {
            print STDERR "Error from session daemon: $line\n";
            $resp = 0;
            last;
        }
        chomp($line);
        if ($line eq '') {
            $Socket->close;
            return $resp;
        }
        push @{$resp}, $line;
    }
    $Socket->close;
    return $resp;
}



### EOP ###
1;

__END__

=head1 BUGS

Bugs? Features!

=head1 SEE ALSO

perl(1)

=head1 AUTHOR

 Copyright (c) 2005 Martin Werthmoeller <mw@werthmoeller.de>

  This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License as
  published by the Fre e Software Foundation; either version 2 of
  the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILIT Y or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 5 9 Temple Place, Suite 330, Boston, MA
  02111-1307 USA

=cut