# 
# based on the original slox login.pm, written by Carsten Hoeger (SuSE Linux AG)
# modified by: Ben Pahne, Stefan Preuss (Netline Internet Service GmbH)
#

package login;
use strict;
use CGI qw(no_xhtml);
#use Net::LDAP;
use MIME::Base64;
use URI::Escape;
use Socket;
use Time::Local;
use Digest::MD5  qw(md5_hex);
use Storable qw(thaw freeze);

use IO::Socket::SSL;
use Net::SSLeay::Handle qw/shutdown/;

# SERVER
my $server_ip = "localhost";
my $server_port = "33333";
my $proto = 'tcp';
my $timeout = 3600;
# UNIX
my $rendezvous = '/var/run/sessiond.sock';
my $readcount = 4096;
# SSL
my $ssl_key_file = '/opt/openexchange/etc/groupware/sslcerts/oxCERTS/groupwarekey.pem';
my $ssl_cert_file = '/opt/openexchange/etc/groupware/sslcerts/oxCERTS/groupwarecert.pem';
my $ssl_ca_file = '/opt/openexchange/etc/groupware/sslcerts/oxCA/cacert.pem ';
my $ssl_use_cert = 1;
my $ssl_verify_mode = '0x01';
# LDAP
#my $scope = 'one';
#my $ldap_conf = '/opt/openexchange/etc/groupware/ldap.conf';
#my $objectcl = 'OXUserObject';
# APACHE
my $loginpath = '/cgi-bin/';
# 1 = unix / 2 = ssl / 3 = plain
my $connection_mode = 2;

# change to fit your ldap tree
my $ldap_userBase = 'ou=Users,ou=OxObjects,';
my $appname = 'OPEN-XCHANGE SERVER';

my $languages = ['IT','DE','EN'];
my $default_lang = 'IT';
my $cookiename = 'open-xchange-login';

sub new {
    my ($this, $cgi, $session) = @_;
    my $class = ref($this) || $this;
    my $self  = {};
    $self->{"cgi"} = $cgi;
    $self->{"mode"} = $connection_mode;
    bless $self, $this;
    return $self;
}

sub display {

    my $this = shift;
    my $cgi = $this->{"cgi"};

    my $uid = lc($cgi->param('uid'));
    $uid =~ s/^\s*(.*?)\s*$/$1/;
    my $passwd = $cgi->param('passwd');

    my $img = $cgi->param("image");

    if (defined $uid && $uid ne "") {
	$this->check_login('groupware');
    } else { 
	if (defined $img && $img ne "") {
	    $this->displayImage();
	} else {
	    $this->login();
	}
    }
}

sub login {

    my $this = shift;
    my $cgi = $this->{"cgi"};
    my $errormsg = shift;

    my $stylesheet = "<style>.button { background-color: #bacadb; width: 75px; } .header { background-color: #ffffff; border-bottom-color: #a2b3c6; border-bottom-style:solid; border-bottom-width: 1px; } .text, .button, .input { font-family: Arial, Helvetica, sans-serif; font-size: 10pt; font-weight: bold; } .tds { padding-left: 10px; padding-top: 10px; padding-right:10px; }</style>";

    print $cgi->header(-charset=>'utf-8');
    print $cgi->start_html(-title => $appname, -bgcolor => '#ffffff', -head => $stylesheet, -head => '<link rel="shortcut icon" href="'.$loginpath.'login.pl?image=ico" type="image/x-icon">');
    
    print "<style>\n";
    print " .button { background-color: #bacadb; width: 75px; }\n";
    print " .button, .input { border:1px #a2b3c6; border-style:solid; }\n";
    print " .header { background-color: #ffffff; border-bottom-color: #a2b3c6; border-bottom-style:solid; border-bottom-width: 1px; }\n";
    print " .text, .button, .input { font-family: Arial, Helvetica, sans-serif; font-size: 10pt; font-weight: bold; }\n";
    print " .tds { padding-left: 10px; padding-top: 10px; padding-right:10px; }";
    print "</style>\n";

    print '<center><br><br><br><br><br>';

    if ($errormsg eq '') {
      print "&nbsp;"
    } else {
      print $cgi->font({-class=>"text", -style=>"color:#ff0000;"}, $errormsg);
    }

    print "<br>&nbsp;";

    print $cgi->start_form(-action => $loginpath.'login.pl', -target => '_top', -name => 'login_form');

    print $cgi->start_table({-cellspacing => 0, -cellpadding => 0});
    print $cgi->start_Tr();
    print $cgi->start_td({-width => '100%'});

    print $cgi->start_table({-style=> 'border:1px #a2b3c6; border-style:solid;', -cellspacing => 0, -cellpadding => 0, -bgcolor => '#e5ecf5'});

    print $cgi->start_Tr();
    print $cgi->start_td({-class => 'header', -colspan => 2, -width => '100%'});

    print $cgi->start_table({-cellspacing => 0, -cellpadding => 0, -width => '100%', -height => '100%'});
    print $cgi->start_Tr();

    print $cgi->start_td({-background => $loginpath.'login.pl?image=back', 
			  -width => '100%', -align => 'center', -valign => 'middle', -nowrap});
    print $cgi->font({-class => 'text', -style => 'font-size: 14pt;'}, "&nbsp;".$appname."&nbsp;");
    print $cgi->end_td();

    print $cgi->start_td();
    print $cgi->img({-src => $loginpath.'login.pl?image=logo'});
    print $cgi->end_td();
    print $cgi->end_Tr();
    print $cgi->end_table();

    print $cgi->end_td();
    print $cgi->end_Tr();

    print $cgi->start_Tr();
    print $cgi->start_td({-align => 'right', -valign => 'middle', -class => 'tds'});
    print $cgi->font({-class => 'text'}, 'Username:');
    print $cgi->end_td();
    print $cgi->start_td({-valign => 'middle', align => 'left', -class => 'tds'});
    print $cgi->textfield(-class => 'input', -style => 'font-weight: normal;', -name => 'uid', -size => 30);
    print "<script>document.login_form.uid.focus();</script>";	
    print $cgi->end_td();
    print $cgi->end_Tr();

    print $cgi->start_Tr();
    print $cgi->start_td({-align => 'right', -valign => 'middle', -class => 'tds'});
    print $cgi->font({-class => 'text'}, 'Password:');
    print $cgi->end_td();
    print $cgi->start_td({-valign => 'middle', align => 'left', -class => 'tds'});
    print $cgi->password_field(-class => 'input', -style => 'font-weight: normal;', -name => 'passwd', -size => 30);
    print $cgi->end_td();
    print $cgi->end_Tr();


    print $cgi->start_Tr();
    print $cgi->start_td({-align => 'right', -valign => 'middle', -class => 'tds'});
    print $cgi->font({-class => 'text'}, 'Accedi a');
    print $cgi->end_td();
    print $cgi->start_td({-valign => 'middle', align => 'left', -class => 'tds'});
    my %labels = ('/servlet/intranet?SITE=beforeAuth&sessionID='=>'Groupware','/servlet/webmail?SITE=mauth&sessionID='=>'Webmail');
    print $cgi->popup_menu(-name=>'whereto',
         -values=>['/servlet/intranet?SITE=beforeAuth&sessionID=','/servlet/webmail?SITE=mauth&sessionID='],
         -labels=>\%labels, 
	 -default=>'/servlet/intranet?SITE=beforeAuth&sessionID=');
    print $cgi->end_td();
    print $cgi->end_Tr();
    
    # maybe later :)
    # my $s = "EN,groupware";
    # my @sa = split(/\,/,$s); 
    # print "param: @sa[0] | @sa[1]\n";

    print $cgi->start_Tr();
    print $cgi->start_td({-align => 'right', -valign => 'middle', -class => 'tds'});
    print "&nbsp;";
    print $cgi->end_td();
    print $cgi->start_td({-valign => 'middle', -class => 'tds', -style => 'padding-bottom:10px;'});
    print $cgi->submit(-class=> 'button', -name => 'login', -value => ' Login ');
    print $cgi->end_td();
    print $cgi->end_Tr();

    print $cgi->end_table();

    print $cgi->end_td();
    print $cgi->end_Tr();

    print $cgi->start_Tr();
    print $cgi->start_td({align => "right"});
    print $cgi->font("<small><a href=\"http://www.open-xchange.org\" target=\"_blank\">http://www.open-xchange.org</a></small>");
    print $cgi->end_td();
    print $cgi->end_Tr();
    print $cgi->end_table();

    print $cgi->end_form();
    print $cgi->end_html();

}


sub check_login {

    my $this = shift;
    my $cgi = $this->{"cgi"};


    my $cgi = $this->{"cgi"};
    my $uid = lc($cgi->param('uid'));
    $uid =~ s/^\s*(.*?)\s*$/$1/;
    my $passwd = $cgi->param('passwd');

    # check pass
    if ( $passwd eq "" ) {
	$this->login("Devi inserire una password!");
	#$this->disp_error('No password set!', undef);
	exit;
    }

    my $whereto = $cgi->param('whereto') || '/servlet/intranet?SITE=beforeAuth&sessionID=';
    my $whichlang = $cgi->param('whichlang') || '/servlet/intranet?SITE=beforeAuth&sessionID=';

    my %data = ();
    $data{uid} = $uid; 
    $data{passwd} = $passwd; 
    #$data{LANG} = 'EN';
    $data{LANG} = 'IT';
    $data{loginDestination} = 'go_groupware';

    my $dref = \%data;
    my $rand = rand((time)*$$);
    my $ID = md5_hex($rand.$dref);

    my $authdata = encode_base64($data{uid}."\1".$data{passwd}."\1".$data{LANG}."\1".$ENV{REMOTE_ADDR}."\1".$ENV{HTTP_HOST});
    $authdata =~ s/\n//g;

    my $SOCK = getSocket($connection_mode);

    if( ! defined $SOCK ) {
        $this->login("Impossibile costruire il Socket!<br>SessionD in esecuzione?");
        exit;
    }

    my $timestamp = timelocal(localtime());
    my $frozen = freeze($dref);
    $frozen = unpack('H*',$frozen);

    print $SOCK "add: $timestamp $timeout $ID $authdata\0";
    $SOCK->flush();

    my $resp = <$SOCK>;
    close($SOCK);

    my $poss = index($resp, 'ERROR');
    my $posss = index($resp, 'CHANGEPASSWD');

    print STDERR $poss."<-";
    if (  $poss != -1 ) {
        $this->login($resp);
    } else{
        if (  $posss != -1 ) {
           $whereto = '/umin/ChangePasswd?auth&sessionID=';
        }

	my $COOKIE = $cgi->cookie(-name=>"open-xchange-session-$ID",
				  -value=>$ID);

	#my $COOKIE = $cgi->cookie(-name=>$cookiename,
	#			  -value=>$data{LANG},
	#			  -path=>"/");
	
	print $cgi->header(-cookie=>$COOKIE, -charset => 'utf-8', -Refresh => '0; URL='.$whereto.$ID);
	print $cgi->start_html(-title => '$appname', -bgcolor => '#ffffff', -align => 'center');
	print 'Reindirizzamento al Groupware ...<br>';
	print "SessionID: $ID<br>";
	print $cgi->end_html();
    }
}

sub disp_error(){
    my $this = shift;
    my $cgi = $this->{"cgi"};
    my $text = shift;
    print $cgi->header( -charset => "utf-8");
    print $cgi->start_html(-title=>"Login", -bgcolor=>"#ffffff", -align=>"center");
    print $text;    
    print $cgi->end_html();
}

sub checkSession(){


    my ($ID, $SOCK) = @_;

    #my $SOCK = getSocket($connection_mode);    
    #print STDERR "checking id->".$ID."\n";
    print $SOCK "ping: $ID\0";
    $SOCK->flush();

    my $read;
    my $line;
    my $ret;
    while( ($ret=sysread($SOCK,$read,4096)))  {
	$line .= $read;
    }
    my $return = 'false';
    if ($line =~ 'OK'){
	$return = 'true';
    }
    print STDERR "bad ->".$ret."\n";
    print STDERR "bad ->".$line."\n";
    close($SOCK);
    return $return;

}

sub getSocket {

    my ($mode) = @_;
    my $sock;

    if( $mode == 1) {
	# unix socket

	socket($sock, PF_UNIX, SOCK_STREAM,0);
	connect($sock, sockaddr_un($rendezvous));
    } elsif ($mode == 2) {
	# ssl socket
	#$IO::Socket::SSL::DEBUG=1;

	$sock = IO::Socket::SSL->new( PeerAddr => $server_ip,
				      PeerPort => $server_port,
				      Proto    => $proto,
				      SSL_key_file => $ssl_key_file,
				      SSL_cert_file => $ssl_cert_file,
				      SSL_ca_file => $ssl_ca_file,
				      SSL_use_cert => $ssl_use_cert,
				      SSL_verify_mode => $ssl_verify_mode );

    } elsif ($mode == 3) {
	# plain socket
	use IO::Socket;
	$sock = new IO::Socket::INET (
					 PeerAddr => $server_ip,
					 PeerPort => $server_port,
					 Proto => $proto,
					 ); 
    }

#    if( ! defined $sock ) {
#	print STDERR "Can not build up Socket!\n";
#	print STDERR "ERRNO=<$!> in getSocket. Can not connect do SessionD\n";
#	exit;
#    }

    #print STDERR "building socker -> ".$sock."\n";
   
    return $sock;
}



#################################################################################
#
# from choeger
#
sub parse_file {
    my $file = shift;
    my @searchfor = @_;

    my @erg = ();
    my $found = 0;
    my @a = read_file($file);

    for(my $i=0; $i<=$#searchfor; $i++) {
        foreach (@a) {
            if($_ =~ /^$searchfor[$i]/i) {
                $_ =~ s/$searchfor[$i]\s*(.*)/$1/i;
                chomp($_);
                push @erg, $_;
                $found = 1;
                last;
            }
        }
        if($found != 1) {
            push @erg, "";
        } else {
            $found = 0;
        }
    }
    return @erg;
}

sub read_file($) {
  my $file = shift;
  local *F;
  open F, $file || die "Impossibile aprire '$file' in lettura: $!; Operazione annullata";
  local $/ unless wantarray;
  <F>;
}

# author: Stefan Preuss
sub displayImage {
    my $this = shift;
    my $cgi = $this->{"cgi"};

    my $logo = "/9j/4AAQSkZJRgABAQEARwBHAAD//gAXQ3JlYXRlZCB3aXRoIFRoZSBHSU1Q/9sAQwAGBAUGBQQGBgUGBwcGCAoQCgoJCQoUDg8MEBcUGBgXFBYWGh0lHxobIxwWFiAsICMmJykqKRkfLTAtKDAlKCko/9sAQwEHBwcKCAoTCgoTKBoWGigoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgo/8AAEQgAMgBnAwEiAAIRAQMRAf/EABwAAAICAwEBAAAAAAAAAAAAAAAGBQcCAwQBCP/EAD0QAAEDAgIGBggEBQUAAAAAAAECAwQAEQUSBhMhMVFhFSIyQVTRBxQXcZGTsdIWI1KhU1VikpRzgYLB4f/EABkBAQEBAQEBAAAAAAAAAAAAAAABAgMEBf/EAB4RAAICAwEBAQEAAAAAAAAAAAABAhEDEiExE0Ei/9oADAMBAAIRAxEAPwD6prVLksxI635TqGmUC6lqNgK21VfpbxB5eKRsPCrR22g8U8VkqG33Afua3jhu6MydKxif9I2CNuqQhEx5I3LQ0AD7rkH9q1+0nB/Dz/lp+6knQzRhOknrmaWqN6vk3N5s2bNzHCmX2YI/my/8cfdXZxxRdMwnN9RI+0nB/Dz/AJafurJv0j4KtxKVNTW0k7VKaBA99lE/tUZ7MEfzZf8Ajj7qW9MtF06NpiFMtUkyCsbW8uXLbmeNFHFJ0g3NdZbS8YjKwhWIwwubHSM1owClEd+wkbuG+loeknBiLiPPt/po+6lj0V4g7H0gMLMSxJbUSnuCki4PwBFS2n2h19bimENkqPWfjpG/ipI48RUUIxlrIuzatDZo7pNh+Pl1MMuIdb2lp0BKiOIsTcVN187Qpb8KU1KhuqafbN0LT3f+U74t6Q35WCNsw2jHnuApedHZQP6O+557ue+rPA7/AJEcnOjXjOm+E4VPXEc177rfbLCQoJP6SSRtrljekHDJMhtiPDxFx5xWVCEtJuT/AHVUsdh2TIbYjtqdecVlShO0qNXFoVoq1gUcPyAHMRcT11bw2P0p/wCz30njhBd9JGUpMaUm6QSCCRuPdRRRXmOpVXSU/wAdM+evzpE03lSXMaQpyQ+tWoTtU4onernThSXpqkjFWlEHKpkWPuUqvo40rPI2SegMyU0jENVKkIuW75HVC/a4GmzpGf4+Z89fnSHojPiwkTBLeS0VlGW4O22a+73imDpzDPGN/BXlScbfgT4TnSM/x8z56/OlPT6ZKdbga2VIXZTls7qjbYniakOnMM8Y38FeVL+ls+LNbiCI+l0oK81gdl7W3+6kI0/A3w06IypDePx1NyHkKyr2pcIPZPOrC6Rn+PmfPX51XWiLal422pIuEIUpXIWt9TUvpHjvq+aJBX+fuW4k9jkOf0qzjtKiJ0iM0pcZTiavVH3S4drwCjlCvfx41D697+M7/eawQhS1pQhJUtRsABck1NzNHJEfDkSEkreAu60BuHLjbvrryPGT0ltCZDbaHFsyX0zx2jrCCE/07d3GmvpGf4+Z89fnVSx3nI7yHmFlDiDcKFPmB4s3ibNjZElA66OPMcvpXLJD9Kn+E90lP8dL/wB31edFclFc6RqwrixXDmcSjap66VA3Qsb0mu2pGIpoYcQhUVErXEkvtpVdGUWtmSRvvS66PSvVaJyrnLJjkdxOYH6V5+E5fiI3xV5VZ8iTh7cIaptlckrTnLbSP4abkZkEWzX3AV4JEF1gLaZjsOKcWVoIQbDZlsVoVs37rDlV+shqisfwnL8RG+KvKvRonLvtkxrf8vKrInTIwS0qGxFbKnV6xGqQ5YdW20p3HrHZbfWIXh4xKQMiBECnLntZkXGUIHcrgb/tV+shqhPawZ2DAUzhrraZDuxyQ5cG3BIANqifwpL8RG+KvKrKdciFt71RUJDmsRqy40DZrKdhzA9a9rnfztWqUuF6oA4ltb+uUSYtmxbIninde/K97VFkYcUKeBYIjDbuvKS7JNwFDckcr/Wpip1xcGylR1xxsQA2ptsW/LTc5lNqub34ce+sMbkw2wgYUmKbrdK/yEq2XGXtJPPdWd22WqEPF9GxKkl6Ettkr2rQq9r8RauSPo1iEd5DzEuOhxBuFAq8qs+WvDC+BCMVDRdWXCptJNjlylOdCtg62wWrWXIAS3qDHWApecrQ2kq65tsU2bdW26w5VpZZUTRC8zrNSjX5NbbrZL5b8r0V1S3kPOnVMtMtpKsqUDuKiRc99r2vwFFAaKKKKAKKKKAKKKKAKKKKAKKKKAKKKKAKKKKA/9k=";

    my $line = "/9j/4AAQSkZJRgABAQEARwBHAAD//gAXQ3JlYXRlZCB3aXRoIFRoZSBHSU1Q/9sAQwAQCwwODAoQDg0OEhEQExgoGhgWFhgxIyUdKDozPTw5Mzg3QEhcTkBEV0U3OFBtUVdfYmdoZz5NcXlwZHhcZWdj/9sAQwEREhIYFRgvGhovY0I4QmNjY2NjY2NjY2NjY2NjY2NjY2NjY2NjY2NjY2NjY2NjY2NjY2NjY2NjY2NjY2NjY2Nj/8AAEQgAMgABAwEiAAIRAQMRAf/EABYAAQEBAAAAAAAAAAAAAAAAAAAGAv/EABkQAQACAwAAAAAAAAAAAAAAAAABAxNTkv/EABYBAQEBAAAAAAAAAAAAAAAAAAADAf/EABYRAQEBAAAAAAAAAAAAAAAAAAARAf/aAAwDAQACEQMRAD8AvwAT+e7db3IwKzE6ANKAA//Z";

    my $ico = "AAABAAEAEBAQAAAAAAAoAQAAFgAAACgAAAAQAAAAIAAAAAEABAAAAAAAwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA////AJBnUADVwLoAWRsAAHVEKQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzNERENEMzRDNEIyRDRDRDM0QzNEM0RDMxVREVURVVERFVERVRVRVRERVVVRVREVUREREREREREREREREREREREREREREREREREREREREREREREREREREREAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA";

    my $img = $cgi->param("image");
    
    print $cgi->header("image/jpeg");
    binmode STDOUT;
    
    if ($img eq 'logo') {
	print decode_base64($logo);
    } elsif ($img eq 'ico') {
	print decode_base64($ico);
    } else {
	print decode_base64($line);
    }
}

1;