#!/usr/bin/perl
#    
#    Information Record Manager
#
#    Featuring: Search, Update, and Dynamic Record Linking
#
#    Copyright (c) 1996, Nigel Hall.  All Rights Reserved
#
#
# @(#)$Id: login,v 1.66 2004/10/12 19:32:20 joseph Exp $

use strict;

my $DEBUG = 0;

use lib "/usr/local/cs/lib";
use Carp;
use Apache;
use CS;
use CGI;
use CSDebug;
use URI::Escape;
$SIG{__WARN__} = \&Carp::carp;
#
sub loginform($$$$$$);
sub printfile($$);
sub valid_login_session($$);
sub valid_login($$$);
sub clearLocks($$);

{
warn "LOGIN SCRIPT" if $DEBUG;
    my $cfg = new CS::Config();
    my $util = $cfg->util;
 
    my $db = new CS::DB( cfg => $cfg );
    
    my $cgi = new CGI;

    $cfg->{_cgi} = $cgi;
    CSDebug::dumpcgienv(50,$cgi);
    
    my $db_ok = $db->connect;
    my $session = CS::Session->new(cfg => $cfg, _db => $db);
    
    $| = 1;
    
    my $infodir = $cfg->param('infodir');
    my $restrict_login = $cfg->param('restrict_login');
    my $track_login = $cfg->param('track_login');
    my $prior_login = $cfg->param('prior_login');
    my $login_central = $cfg->param('login_central');

    my $layoutdir = "$infodir/layouts";
    $layoutdir .= $cfg->param('layoutdir') if defined $cfg->param('layoutdir');
    
    my $xlayout = $cgi->param('x-layout') if $cgi->param('x-layout');
    
    unless( $xlayout ) {
        $xlayout = "login";
    }
    
    my $layout = new CS::Layout( cfg => $cfg, layout => $xlayout );
    
    my $action = $cgi->param('x-a');
    my $usertable = "u";
    
    my $cookie_domain = $cfg->param('cookie_domain');
    my $cookie_path = $cfg->param('cookie_path');
    my $login_redirect = $cfg->communityRecord->param('login_redirect') || $cfg->param('login_redirect') || "/home";
    my $arg_redirect = $cgi->param('x-redirect');
    my $cgiref = $cfg->cgiref;
    my $password_time_limit = $cfg->param('password_time_limit');
    my $password_change_com = $cfg->param('password_change_com');
    
    
    unless ( $login_redirect =~ /^http:/i ) {
        if ( $layout->{community} ) {
            $login_redirect = "/cs/$layout->{community}" . $login_redirect;
        } else {
            $login_redirect = "/cgi-bin/cs" . $login_redirect;
        }
    }
    
    if ( $arg_redirect ) {
        $arg_redirect =~ s/%26/\&/g;
        $login_redirect = $arg_redirect;
    }
    my ($user,$userrec);
    my $logout = $cgi->param('logout') || $cgi->url_param('logout');
    my $x_logout = $cgi->param('x-logout');

    # x-sid holds the user session in webservice calls.
    my $session_key = $cgi->cookie('session_key') || $cgi->param('x-sid');
              
    $logout      = '' if !defined $logout;
    $x_logout    = '' if !defined $x_logout;
    $session_key = '' if !defined $session_key;

warn "logout: ($logout) csk: ($session_key) ",
     "ip: $ENV{REMOTE_ADDR} ",
     "login_redirect: $login_redirect\n" if $DEBUG;
   
    if ( ( $logout || ( $x_logout eq "yes" ) ) &&
      $session_key and
      $user = $session->loadSession($session_key)) {

    $session->deleteSession($session_key);
    my $cookie = $cgi->cookie( -name => 'session_key',
                               -domain => $cookie_domain,
                               -path => $cookie_path,
                               -value => $session_key,
                               -expires => '-1d');
    clearLocks($db, $cfg);

    # SCSO - Send users to the central server to log him out of all sites
    if ($cfg->param('logout_central')) {
        # Don't send the user back to the central server if he was just there. 
        $arg_redirect = $cfg->param('logout_central') unless $cgi->param('x-status') eq "logout";
    }

    if ( $arg_redirect ) {
        print $cgi->header( -type => 'text/html',
                            -cookie => $cookie, -Refresh => "0; URL=$arg_redirect" );
        print "\n";
        exit(); # Apache::exit()
    }

    print $cgi->header(-type => 'text/html', -cookie =>  $cookie );
    loginform($cgi, $cfg, $layout, $login_redirect, $infodir, "" );
    } elsif ( $x_logout eq "break" ) { #exercise the infamous .foo.com cookie login bug
        print $cgi->header( 
          -cookie => $cgi->cookie( 
            -name => "session_key",
            -value => time,
            -path => "/",
            -expires => "+10y",
            -domain => ( $cookie_domain =~ /(\.[^.]+\.[^.]+$)/os ) ),
          -redirect => $cgi->url( -absolute => 1, -query => 0 ) );  
    } elsif ( ( $x_logout eq "clear" ) &&
      ( $cgi->cookie('session_key') and $user = $session->loadSession($session_key) ) ) {
        $session->deleteSession($session_key);
        my $cookie = $cgi->cookie( -name => 'session_key',
                                   -domain => $cookie_domain,
                                   -path => $cookie_path,
                                   -value => $session_key,
                                   -expires => '-1d');
        my $cookie2 = $cgi->cookie( -name => 'user',
                                    -domain => $cookie_domain,
                                    -path => $cookie_path,
                                    -value => $user,
                                    -expires => '-1d');
        print $cgi->header( -type => 'text/html',
                            -cookie => [$cookie,$cookie2], -Refresh => "0; URL=$login_redirect" );
        $layout->printfile("refresh.html");
        print "\n";
        exit(); 
    } elsif ( ($x_logout eq "clear") && ($user = $cgi->cookie('user')) ) {
        my $cookie2 = $cgi->cookie( -name => 'user',
                                    -domain => $cookie_domain,
                                    -path => $cookie_path,
                                    -value => $user,
                                    -expires => '-1d');
        print $cgi->header( -type => 'text/html',
                            -cookie => $cookie2,
                            -Refresh => "0; URL=$login_redirect" );
        $layout->printfile("refresh.html");
        print "\n";
        exit(); # Apache::exit()
    } elsif ( $session_key and $user = $session->loadSession($session_key) ) {
        $cfg->{userLogin} = $user;
        print $cgi->redirect( $login_redirect );
        exit(); 
    } elsif ( 
            ( $cgi->param('x-gid') ) || 
            ( $cgi->param('login') ) || 
            ( $cgi->param('email') ) 
          ) {

    my $login;
    if ( $cgi->param('email') ) {
        $login = $cgi->param('email');
    } else {
        $login = $cgi->param('login');
    }

        my $gid = $cgi->param('x-gid');
    if ( $gid ) {
            #Do x-get to get user info
            # XXX sid?
        my ( $session_ok, %SDATA, $sid ) = valid_login_session( $cfg, $gid );
 
        if ( $session_ok ) {
            $user = $login = $SDATA{login};
            $session_key = $session->newSession( 
                                  login => $user, 
                                  session => $SDATA{session}, 
                                  user_id => $SDATA{id},
                               );
        } 
            else {
                #When would an sid not be alright? 
                print $cgi->redirect($cfg->param('logout_central'));
                exit;
        }

    } elsif ( $session->userLogin( login => $login,
        password => $cgi->param('password'))) {
        $user = $cfg->userLogin || $session->{userLogin} || $login;
        $session_key = $session->newSession( login => $user, 
                                             user_id => $cfg->userID( login => $user ) );
    } else {
        print $cgi->header(-type => 'text/html');
        my $error_msg = $cfg->templateFetch( "u/invalid_login.error" ) || "Invalid login/password";
        loginform($cgi, $cfg, $layout, $login_redirect, $infodir, $error_msg );
        exit(); # Apache::exit()
    }

    
    my $userrec = $cfg->userRecord( $user );
        if ( $track_login ) {
        my @FIELDS;
        push( @FIELDS, "last_login" );
            if ( $prior_login ) {
            $userrec->{ARGS}->{'prior_login'} = $userrec->{ARGS}->{'last_login'};
            $userrec->{ARGS}->{'prior_login'} =~ s/\//-/g;
            push( @FIELDS, "prior_login" );
        }
        $userrec->{ARGS}->{'last_login'} = $userrec->createtime;
        $userrec->{ARGS}->{'last_login'} =~ s/\//-/g;
        $userrec->write( fieldlist => \@FIELDS );
    }

        if ( $restrict_login ) {
        my %USER = %{$userrec->{ARGS}};
        if ( eval $restrict_login ) {
                print $cgi->header(-type => 'text/html');
                my $error_msg = $cfg->templateFetch( "u/inactive_account.error" ) || "Inactive User Account";
                     loginform($cgi, $cfg, $layout, $login_redirect, $infodir, $error_msg );
                    exit(); # Apache::exit()
        }
        }
    unless( $cgi->param('password') || $gid )  {
        print $cgi->header(-type => 'text/html');
        my $error_msg = $cfg->templateFetch( "u/invalid_login.error" ) || "Invalid login/password";
        loginform($cgi, $cfg, $layout, $login_redirect, $infodir, $error_msg );
        exit(); # Apache::exit()
    }

    unless( $userrec )  {
        print $cgi->header(-type => 'text/html');
#           my $error_msg = $cfg->templateFetch( "u/no_account.error" ) || "No User Account Found";
        my $error_msg = $cfg->templateFetch( "u/invalid_login.error" ) || "Invalid login/password";
        loginform($cgi, $cfg, $layout, $login_redirect, $infodir, $error_msg );
        exit(); # Apache::exit()
    }

        if ( my $comm_redir = $cfg->communityAccessDenied ) {
        print $cgi->header(-type => 'text/html');
           my $error_msg = $cfg->templateFetch( "u/restricted_access.error" ) || "Access Denied: Restricted Private Community";
        loginform($cgi, $cfg, $layout, $login_redirect, $infodir, $error_msg );
        exit(); # Apache::exit()
        }

    my $cookie_expires = $cfg->param('cookie_expires') || "+1y";
    my $cookie_path = $cfg->param('cookie_path');

    my $cookie = $cgi->cookie( -name => 'session_key',
                               -domain => $cookie_domain,
                               -path => $cookie_path,
                               -value => $session_key,
                               -expires => $cookie_expires );
    
    my $cookie2 = $cgi->cookie( -name => 'user',
                                -domain => $cookie_domain,
                                -path => $cookie_path,
                                -value => $userrec->{id}, 
                                -expires => "+1y" );
            my $user_date = $userrec->{ARGS}->{'last_chpw'};
            if ((defined $password_time_limit) && (defined $password_change_com)){
                    my @chk_com = split /,|\s/, $password_change_com;
                    if (&user_password_timed_community($cfg, \@chk_com, $userrec->{id})){
                            if (&check_password_login($cfg, $user_date, $password_time_limit)){
                                    $login_redirect = $cgi->param('x-redirect');
                                    my $f = new CS::Form(cfg => $cfg, table => 'u', id => $userrec->{id} );
                                    my $a = new CS::Actions( cfg => $cfg, table => 'u', file => "record.actions", record => $f->{r} );
                                    my %zcpw = $a->param('zcpw');
                                    $login_redirect =~ s/home$//;
                                    $login_redirect .= qq!changepw/u/$userrec->{id}?x-r=zcpw&newpass=yes!;

                            }

                    }
            }

    if ( $login_redirect ) {
        print $cgi->header(-type => 'text/html',
                   -cookie => [$cookie,$cookie2], -Refresh => "0; URL=$login_redirect" );
        
        $layout->printfile("refresh.html");
        print "\n";

        exit(); # Apache::exit()
    } else {
        print $cgi->header(-type => 'text/html',
                   -cookie => $cookie);
    }
    
    $layout->pre;
    printfile( $arg_redirect, "$layoutdir/login/login_complete.html" );
    $layout->post;
    } elsif ( $login_central ) {
        # If we've already been logged out from the central site then just
        # proceed with the x-redirect.

        if ( ($cgi->param('x-status') eq 'logout') &&
             ($cgi->param('x-redirect') ) ) {
            print $cgi->redirect($cgi->param('x-redirect'));
            exit;
        }
        #SCSO - if there wasn't a x-gid then we need to redirect back to members
        # XXX Does the self_url need to be encoded?

        my $url = $login_central;
        my $self_url = $cgi->self_url;
        $self_url = $cfg->url;
        $self_url = URI::Escape::uri_escape($self_url);
        
        $login_central .= "?x-url=$self_url";
        print $cgi->redirect( $login_central );
        exit;

    } else {
    my @cookies;

    if ( defined $cgi->cookie("session_key") ) {
        # expire bunk session_key cookies, if possible,
        # from the stated cookie domain, and every superdomain.
        my @vals    = ( -name => "session_key", -value => 1, -path => "/", -expires => "-1y" );

        my @domains = reverse split( /(?=\.(?![^.]*$))/, $cookie_domain );
        #split if the next char is a dot with another dot before end-of-string
        $domains[$_] .= $domains[$_ - 1] for ( 1 .. $#domains );

        @cookies = map { $cgi->cookie( @vals, -domain => $_ ) } @domains; 
    }

    print $cgi->header(-type => 'text/html', ( @cookies ? ( -cookie => \@cookies ) : () ));
    loginform($cgi, $cfg, $layout, $login_redirect, $infodir, "");
    }
}

sub user_password_timed_community{
    my ($cfg, $coms, $user_id) = @_;
    my $dbh = $cfg->dbhandle;
    my ($sql, $cmd, $com_id);
    my $relation_found = 0;
    foreach my $c (@{$coms}){
        if ($c =~ /all/i){
            $relation_found = 1;
            last;
        } 
        $sql = qq!select cs_rid from cs_com_u_l where u_id = $user_id and cs_com_id = $c !;
        $cmd = $dbh->prepare( $sql);
        $cmd->execute;
        $com_id = $cmd->fetchrow_array();
        if ($com_id){
            $relation_found = 1;
        }
        last if ($relation_found);
    }
    return ($relation_found);
}



sub check_password_login{
    my ($cfg, $user_date, $password_time_limit) = @_;
    my ($err, $do_redirect);
    $user_date =~ s/\s*\d+:\d+:\d+$//;
    $user_date =~ s/\-//g;
    $do_redirect = 0;
    
    my $date;
    my ($pyear,$pmonth,$pday) = ($password_time_limit =~ /(\d+),(\d+),(\d+)/); 
    if ((defined $pyear) && (defined $pmonth) && (defined $pday)){
         $date=&return_mysql_date($cfg,$pyear, $pmonth, $pday);
         $date =~ s/\-//g;
         $do_redirect = 1 if ($user_date < $date);
    }
    return ($do_redirect);
}

sub return_mysql_date {
    my ($cfg,$y, $m, $d) = @_;
    my $dbh = $cfg->dbhandle;
    my $sql = qq!select DATE_SUB(CURDATE(),interval $y year)!;
    my $cmd = $dbh->prepare( $sql);
    $cmd->execute;
    my $d1 = $cmd->fetchrow_array();
    $sql = qq!select DATE_SUB('$d1',interval $m month)!;
    $cmd = $dbh->prepare( $sql);
    $cmd->execute;
    my $d2 = $cmd->fetchrow_array();
    $sql = qq!select DATE_SUB('$d2',interval $d day)!;
    $cmd = $dbh->prepare( $sql);
    $cmd->execute;
    my $final_date = $cmd->fetchrow_array();
    return ($final_date);
}


sub valid_login($$$) {
    my ($cfg, $login, $user_id) = @_;

    my $sqlbuf = "select cs_rid from u where login = '$login'";

    if ( $user_id ) {
        $sqlbuf = "select cs_rid from u where cs_rid = '$user_id'";
    }

    my $dbh = $cfg->dbhandle;
    my $cmd = $dbh->prepare( $sqlbuf );
    $cmd->execute;
    my $val;
    $val = $cmd->fetchrow_array();
    return $val;
}

#SCSO Code - Do x-get based on $session
# login is a screen name and id is the orn_id
sub valid_login_session($$) {
    my ( $cfg, $session ) = @_;
    my $cgi     = $cfg->cgi;
    my $referer = $cgi->referer;
    my $login_central = $cfg->param('login_central');
    my $real_session;

    #Get user's data from central site
    use LWP::Simple;
    my $domain = $ENV{SERVER_NAME} || $cfg->param('domain');
    my $get_url       = "$login_central?x-get=$session&x-domain="
        . $domain;
    
    my $buf           = LWP::Simple::get( $get_url );
   warn "XGET RESULT: $buf" if $DEBUG; 
    my @PAIRS = split( /&/, $buf );

    my %SESSION_DATA;
    foreach my $pair ( @PAIRS ) {
        my( $option, $value ) = split( /=/, $pair );
        $SESSION_DATA{$option} = URI::Escape::uri_unescape($value);
    }

    my $status;
    if ( $SESSION_DATA{status} ) {
        $status = $SESSION_DATA{status};
    }
    $real_session = $SESSION_DATA{session};

    #Translate data to CS fields
    $SESSION_DATA{login} = $SESSION_DATA{screen_name};
    if ($cfg->param('remote_user_idfield')) {
        $SESSION_DATA{id} = $SESSION_DATA{
            $cfg->param('remote_user_idfield')};
    }

    if ( $SESSION_DATA{status} ne "ok" ) {
        return 0;
    }

    
    # Does the user exist?
    my @XGET_FIELDS = split(',', $cfg->param('xget_field_list'));
    my $user_id = valid_login( $cfg, $SESSION_DATA{login}, $SESSION_DATA{id} );
    # Update existing users.
    if( $user_id ) {
        my $urec = CS::Record->new( cfg => $cfg, path => "u/$SESSION_DATA{id}" );
        $urec->{ARGS}{$_} = $SESSION_DATA{$_} foreach @XGET_FIELDS;
        $urec->write( fieldlist => \@XGET_FIELDS );
        # Make sure this session doesn't already exist in the db
        my $session = CS::Session->new(cfg => $cfg);
        $session->deleteSession($SESSION_DATA{session});
    }
    #If there's no id, then we need to create one
    else {
        # XXX What if there is no id, but the user exists.
        if ( $cfg->param('remote_user_create') ) {
            my $urec = CS::Record->new( cfg => $cfg, table => "u" );
            $urec->{ARGS}{$_} = $SESSION_DATA{$_} foreach @XGET_FIELDS;
warn Dumper($urec->{ARGS}) if $DEBUG;
            my $id = $urec->write( fieldlist => \@XGET_FIELDS );
            $SESSION_DATA{id} = $id;
warn "SERVER_NAME: $ENV{SERVER_NAME} , $ENV{HTTP_X_FORWARDED_HOST}, " . $cfg->param('domain') if $DEBUG;
            my $xdomain = $ENV{SERVER_NAME} || $cfg->param('domain');
            my $get_url = "$login_central?x-set=$real_session&x-field=" . 
                $cfg->param('remote_user_idfield') . 
                "&x-value=$id&x-domain=". $xdomain;
                #$cfg->param('domain');
            my $buf = LWP::Simple::get( $get_url );
            if ($buf =~ m/error/o) {

                $urec->delete;
            }
        } else {
            warn "Error: trying to create user, but remote_user_create is not set";
            return 0;
        }
    }

    return ( $real_session, %SESSION_DATA, $real_session );
}

sub loginform($$$$$$) {
    my ($cgi, $cfg, $layout, $login_redirect, $infodir, $msg) = @_;
    my $user = $cgi->cookie('user');

    $layout->pre;
    print "<font color=red><b>$msg</b></font><p>" if $msg;
    
    my $template = '';
    my $community = $cfg->community;

    $template = $cgi->param('x-template') if $cgi->param('x-template');;
    $template =~ s/\.form//g;

    my $table = "u";
    if ( $template && $cfg->templateExists( "$table/$template.form" ) ) {
    $template .= ".form";
    } elsif ( $cfg->templateExists( "$table/$community.login.form" ) ) {
    $template = "$community.login.form";
    } elsif ( $cfg->templateExists( "$table/login.form" ) ) {
    $template = "login.form";

    } else {
    print "<font color=red><b>Error: </b></font>";
    if ( $template ) {
        print "<b>$template.form</b> does not exist and ";
    }
    print "No Login Form is defined.<br><br>";
    print "You need <b>login.form</b> defined in the <b>$infodir/tables/u</b> directory<br>";
    $layout->post;
    exit(); # Apache::exit()
    }
    my $f;
    if ( $user && ( ! $cfg->param('no_login_prefill') ) ) {
#    if ( $user = $cgi->cookie('user') ) {
    $f = new CS::Form( cfg => $cfg, table => "u", id => $user, template => $template );
    unless ( $f->{r}->{id} ) {
        $f = new CS::Form( cfg => $cfg, table => "u", template => $template );
    }
    } else {
    $f = new CS::Form( cfg => $cfg, table => "u", template => $template );
    }

    $f->{ARGS}{password} = "";
    $f->addButton( "Login" );
    $f->{HIDDEN}{'x-redirect'} = $login_redirect;

    $f->edit;
    
    $layout->post;
}

sub printfile($$) {
    my ($arg_redirect, $file) = @_;
    unless( open( TFILE, $file ) ) {
    exit(); # Apache::exit()
    }
    
    while ( <TFILE> ) {
    print;
    if ( ( m/\<form/i ) && ( $arg_redirect ) ) {
        print qq#\n<INPUT TYPE=HIDDEN NAME=x-redirect VALUE="$arg_redirect">\n#;
    }
    }
    close( TFILE );
}

sub clearLocks($$) {
    my ($db, $cfg) = @_;
    
    my $id = $cfg->userID;
    my $table = $cfg->maptable('cs_lck');
    my $sqlbuf = "DELETE from $table where cs_uid = '$id'";
    my $rv = $db->{dbh}->do( $sqlbuf );
    unless( defined $rv ) {
    my $error = $db->{dbh}->errstr;
    #        Log(0, "Clear Lock Error: $error\n");
    }
}

sub email2login($$) {
    my ($cfg, $email) = @_;
    my $dbh = $cfg->dbhandle;
    my $sqlbuf = "select login from u where email = '$email'";
    my $cmd = $dbh->prepare( $sqlbuf );
    $cmd->execute;
    my $val;
    $val = $cmd->fetchrow_array();
    return $val;
}

=head1 NAME

=head1 SYNOPSIS

=head1 DESCRIPTION

=head1 OPTIONS

=head1 RETURN VALUE

=head1 ERRORS

=head1 DIAGNOSTICS

=head1 EXAMPLES

=head1 ENVIRONMENT

=head1 FILES

=head1 CAVEATS

=head1 BUGS

=head1 RESTRICTIONS

=head1 NOTES

=head1 SEE ALSO

=head1 AUTHOR

=head1 HISTORY

=cut