package ACIS::Web;

#   Continuing ACIS::Web class, although this is already another file
#   (ACIS::Web::Services)

use strict;
use Data::Dumper;
use Carp::Assert;

use ACIS::Common;
use ACIS::Data::DumpXML qw(dump_xml);
use ACIS::Web;

use Encode qw/encode decode/;



####   SESSION STUFF   ####


sub start_new_session {

  my $self  = shift;
  my $owner = shift;
  my $type  = shift;

  assert( ref $self );
  assert( not $self -> session );

  my $home   = $self -> {home};
  my $sessions_dir = "$home/sessions";

#  assert ( -w $sessions_dir ) ;

  my $sid = 0;
  my $session;
  my $filename;
  my $lifetime = $self -> config( 'session-lifetime' );
  
  debug "generate session-id";
  
  while ( not $sid ) {
    
    $sid = generate_id ();
    
    debug "generated '$sid' id";
    
    $filename = "$sessions_dir/$sid";
    
    $sid = 0 if (-f $filename);
  }
  
  if ($sid and open SESSION, "> $filename") {
    print SESSION 'new session';
    close SESSION;
    
    debug "session '$filename' created";
    
    $session = ACIS::Web::Session -> new( $sid, $filename, $type, $owner, $lifetime );
    
    $self -> session( $session );

    $self -> userlog( "new session ($type): $sid" );
    
  } else {
    die "Can't create session file $filename";
    $self -> errlog( "Can't create session file $filename" );
  }

  return $session;
}





sub load_session {

  my $app = shift;
  
  my $request  = $app -> request;
  my $home     = $app -> {home};
  
  my $sid      = $request -> {'session-id'};

  unless ($sid) {
    $app -> clear_process_queue;
    return undef;
  }

  my $IP      = $ENV{'REMOTE_ADDR'};
  
  my $sessions_dir = "$home/sessions";
  my $sfilename     = "$sessions_dir/$sid";

#  assert( -f $sfilename );
 
  my $session = ACIS::Web::Session::load ( $sfilename );

  if ( not $session 
#       or not $session -> not_yet_expired()  ### XXX EXPIRE SESSION CHECK
     ) {
    $app -> error( "session-failure" );
    $app -> set_presenter ( 'sorry' );
    $app -> clear_process_queue;
    # XXX
    debug "can't load the session, session expired or ACIS::Web::Session::load";

    return undef;
   }


#  if ( 1 ) {
  if ( $session -> owner -> {IP} eq $IP ) {
    debug "previous session found, IP matches, continuing";
    
    # use Data::Dumper;
    # my $dump = Dumper( $session );
    # debug "session is like this <$dump>";

  } else {

    # IPs don't match -- should not continue
    debug "can't load the session, IP addresses don't match";

    $app -> error( "session-failure" );
    $app -> set_presenter ( 'sorry' );
    $app -> clear_process_queue;

    # XXX
    return undef;
  }

  $app -> session( $session );

  return $session;
 }

####  END OF SESSION STUFF  ####


####  A U T H E N T I C A T I O N    ####

sub authenticate {
  my $app = shift;

  ### if a session is already loaded, why authenticate?

  return undef if $app -> session;

  ### some preparations
  my $request  = $app -> request;
  my $home     = $app -> {home};
  my $paths    = $app -> {paths};
  my $vars     = $app -> variables;

  my $login;  # that is what we need to find out
  my $passwd;

  debug "check CGI parameters and cookies";
  
  # now we find out

  my $query        = $request -> {'CGI'};
  my $query_params = scalar $query -> param;
 
  $login  = $query -> param( 'login' ); 
  $passwd = $query -> param( 'pass' );
 
  if ( not defined $login ) {
    $login = $query -> cookie ( 'login' );

    if( not defined $passwd ) {
      $passwd = $query -> cookie( 'pass' );
    }
  }

  # final check
  if ( not defined $login
       or not defined $passwd ) {

    $app -> clear_process_queue;
    $app -> set_form_value( 'login', $login );
    $app -> set_presenter ( 'login' );

    return undef;
  }
  
  debug "we do have both login ($login) and password ($passwd)";
  
  ###  now it's time to check, if such a user exists and if her
  ###  password matches to the one entered.
  ###  if both true, check the lock;
  ###  if no lock, load userdata into $app

  my $udata;

  $app -> update_paths_for_login( $login );

  my $udata_file    = $paths -> {'user-data'};

  my ( $uprefix )   = ( $udata_file =~ /(.+)\.xml$/ );
  my $udata_lock    = $paths -> {'user-data-lock'};
  my $udata_deleted = $paths -> {'user-data-deleted'};


  if( not -f $udata_file ) {

    # no such user 
    $app -> errlog( "login attempt failed, user not found: $login" );
    $app -> set_form_value( 'login', $login );
    $app -> error ( 'login-unknown-user' );
    $app -> clear_process_queue;

    return undef;
  }

  debug "going to load user-data to check password";

  $udata = load ACIS::Web::UserData ( $udata_file );

  if( not defined $udata
    or not defined $udata->{owner}
    or not defined $udata->{owner}{login}
    or not defined $udata->{owner}{password} 
    ) {

    $app -> errlog( "[$login] userdata file $udata_file is damaged" );
    $app -> error( 'login-account-damaged' );
    $app -> clear_process_queue;
    $app -> set_presenter ('sorry');
    return undef;
  }


  if ( $passwd ne $udata -> {owner} {password} ) {

    $app -> errlog( "[$login] login attempt failed, wrong password ($passwd)" );
    $app -> set_form_value( 'login', $login );
    $app -> error( 'login-bad-password' );
    $app -> clear_process_queue;
    
    $app -> set_presenter ('login');
    return undef;
   }

  debug "password match, now check user-data lock file ($udata_lock)";
 
  my $lock = $udata_lock;
  
  if ( -f $lock ) 
   {{

    debug "found lock file at '$lock'";
      
    open LOCK, $lock;
    my $sid = <LOCK>;
    close LOCK;

    debug "locked by session $sid";

    ### go get the session, if it exists
    ### ignore the lock if it doesn't
    ### if it exists, see if user wants to steal it...
    
    my $file = "$home/sessions/$sid";

    if ( not -f $file ) {
      debug "but session doesn't exist anymore ($file)";
      last;
    }
    
    my $session = ACIS::Web::Session::load ( $file );
      
    if (
	not defined $session 
	or not $session 
       ) {
      unlink $lock;
      debug "but session doesn't exist anymore ($session)";
      last;
    }
    
    debug "and in fact, there is a session, and it belongs to the user";
    
    ### XXX  SESSION (steal session)
    ### steal it?
    ### because we could
    

#    last if $ACIS::DEBUG;
    
    my $owner = $session -> owner;

    $vars -> {'locked-by'} = $owner;

    $app -> errlog( "[$login] login attempt failed, userdata locked" );
    $app -> error( 'login-account-locked' );
    $app -> clear_process_queue;
    $app -> set_presenter ('sorry');
    return undef;
     
  }} else {
    debug 'lock file not found';
  } 
   
  ### update $app with just loaded user data
  
  $app -> { 'user-data' } = $udata;
    
  ### now need to create a session
  
  my $owner = $udata -> {owner};

  if( $owner->{login} ne $login ) {
    $app -> errlog( 
       "[$login] login entered and in userdata's owner don't match, userdata: $owner->{login}" );
    assert( 0, "a problem with your account" );
  }

  $owner -> {'IP'} = $ENV {'REMOTE_ADDR'};

  my $session = $app -> start_new_session ( $owner, "user" );
  
  my $sid = $session -> id;
  
  debug "new session created: $sid";
  
  $session -> lock( $udata_lock );

  if (open LOCK, "> $udata_lock") {
    print LOCK $sid;
    close LOCK;
    debug "lock created";
  }
  
  ### make a copy of userdata in session

  $session -> {'user-data'} = $udata;

  my $auto_login = $query -> param ('auto-login');
  
  if ($auto_login)  {
    print "Set-Cookie: login=$login; path=/\n";
    print "Set-Cookie: pass=$passwd; path=/\n";
    debug "cookie set";
  } 

  ### redirect to the same screen, but with session id

  my $base_url = $app -> config( 'base-url' );
  my $screen   = $app -> {request} -> {screen};

  my $URI = "$base_url/$screen!$sid";

  $app -> userlog( "logged in", ($screen and $screen ne 'index') ? " to screen $screen" : '' );

  debug "requesting a redirect to $URI";
  
  $app -> clear_process_queue;
  $app -> redirect( $URI );
  
#  $app -> update_paths;
  
  return $udata;
}



sub load_session_or_authenticate {
  my $app = shift;
  
  if( $app -> request ->{'session-id'} ) {
    $app -> load_session;
    
  } else {
    my $udata = $app -> authenticate;
    return $udata;
  }

}




##############################################################
####################   EMAIL  SENDING   ######################
##############################################################

sub send_mail {
  my $self = shift;
  my $stylesheet = shift;
  
  debug "sending email with template '$stylesheet'";

  my $config = $self -> config;


  ### iku: we use the same data structure for email and web: presenter-data
 

  my $message = $self -> run_presenter( $stylesheet );

  
  my ($header, $body) = ($message =~ /^(.*?)\s*\n\n+(.*)$/s);

  my @headers = split (/\s*\n/, $header);

  debug "Headers: $header\n";

  $header = '';
  
  foreach (@headers) {
#     $_ = Encode::decode_utf8( $_ );
    my ($name, $value) = split (/:\s*/, $_);
    $value = encode('MIME-Q', $value);

    ### XXX Nasty hack to fix Encode's "feature":
    $value =~ s!\"\n\s+!\"!;  
    $header .= "$name: $value\n";
  }
  
  $header .= "MIME-Version: 1.0\n";
  $header .= "Content-Type: text/plain; charset=utf-8\n";
  $header .= "Content-Transfer-Encoding: 8bit\n";
  
#  debug "[body]\n$body";
#  debug "[header]\n$header";

  my $sendmail = $config -> {'sendmail'};
  
  unless ( defined $sendmail and $sendmail )
   {
    debug "can't send email message, because no sendmail path defined";
    return;
   }

  
  open MESSAGE, "|-:utf8", $sendmail;
  print MESSAGE $header, "\n", $body;
  close MESSAGE;


 }

##########################################################
############### FORM PROCESSING STUFF ####################
##########################################################

sub form_invalid_value {
  my $self = shift;
  $self -> form_error( 'invalid-value', shift );
}


sub form_required_absent {
  my $self = shift;
  $self -> form_error( 'required-absent', shift );
}


sub form_error {

  my $self    = shift;
  my $place   = shift;
  my $element = shift;
  
  if ( ref $self -> {'presenter-data'} {response} {form} {errors} {$place}
       ne 'ARRAY' 
     ) {
    $self -> {'presenter-data'} {response} {form} {errors} {$place} =
      [ $element ];
    return;
  }

  push @{ $self -> {'presenter-data'} {response} {form} {errors} {$place} },
    $element;

}




sub set_form_action {
  my $self   = shift;
  my $action = shift;

  $self -> {'presenter-data'} {response} {form} {action} = $action;
}


sub set_form_value {
  my $self    = shift;
  my $element = shift;
  my $value   = shift;
  
  $self -> {'presenter-data'} {response} 
    {form} {values} {$element} = $value;

  debug "set form value $element: $value";
}


sub get_form_value {
  my $self    = shift;
  my $element = shift;

  my $value = $self -> {'presenter-data'} -> {request} ->
    {form} -> {input} -> {$element};

  return $value;
}



sub path_to_val
 {
  my $data  = shift;
  my $path  = shift;
  
  my @path  = split '/', $path;
  foreach (@path)
   {
    $data = $data -> {$_};
   }
  return $data;
 }

sub assign_path
 {
  my $data  = shift;
  my $path  = shift;
  my $value = shift;

  assert( $data );
  assert( $path );
#  assert( $value );

  my @path = split '/', $path;
  my $last = pop @path;
  foreach (@path)
   {
    unless (defined $data -> {$_})
     { $data -> {$_} = {}; }
    
    $data = $data -> {$_};
     
   }
  $data -> {$last} = $value;
 }


sub prepare_form_data {

  my $self   = shift;
  
  my $screen        = $self -> request -> {screen};
  my $screen_config = $self -> config -> screen ($screen);
  my $params        = $screen_config -> {variables};

  foreach (@$params) {

    next unless defined $_ -> {place};
      
    my $data;
      
    my @places = split ',', $_ -> {place};
      
    foreach my $place ( @places ) {   ### XXX multiple passes will overwrite previous values
      my ( $prefix, $place ) = split ':', $place;
      
      if ( $prefix eq 'owner' ) { 
	$data = $self -> session -> {'user-data'} {owner}; 
	
      } elsif( $prefix eq 'record' )  {
	$data = $self -> session -> current_record; 
	
      } elsif( $prefix eq 'session' )  {
	$data = $self -> session;
      }
      
      $self -> set_form_value ( $_ -> {name}, path_to_val ($data, $place) );
    }
  }
}



sub check_input_parameters {
  my $self   = shift;
  
  my $required_absent;
  my $invalid_value;
  my $screen        = $self -> request -> {'screen'};
  my $screen_config = $self -> config -> screen ( $screen );
  my $params        = $screen_config -> {'variables'};

  my $vars   = $self -> variables;
  
  my $form_input  = $self -> {'presenter-data'} {request} 
    {form} {input};
  
  my $cgi = $self -> {request} {CGI};
  
  debug "checking input parameters";
  debug "loading CGI::Untaint";

  my $handler = new CGI::Untaint ( {INCLUDE_PATH => 'ACIS/Web'}, $cgi -> Vars );
  

  my $errors;
  
  foreach ( @$params ) {
    my $type     = $_ -> {type};
    my $name     = $_ -> {name};
    my $required = $_ -> {required};
    

    my $error;
    my $value;

    if ( defined $form_input -> {$name} ) {
      
      my $orig_val =  $form_input -> {$name};

      debug "parameter '$name' with value '$orig_val'";

      $orig_val =~ s/(^\s+|\s+$)//g;

      if( $orig_val ) {
	
	if( $type ) {
	  $value = $handler -> extract( "-as_$type" => $name );
	  $error = $handler -> error;

	  if ( $error ) {
	    debug "invalid value at $name with type='$type' ($error)";
	    
	    form_error ( $self, 'invalid-value', $name );
	    $errors = 'yes';
	    $value = $orig_val;
	  }

	} else {
	  $value = $orig_val; 
	}

      } else {
	
        if ($required) {
	  debug "required value at $name is empty";
          $self -> form_error ( 'required-absent', $name );
	  $errors = 'yes';
	}
	$value = '';
      }

      $value = Encode::decode_utf8( $value );
      $self -> set_form_value ( $name, $value );

    } else {

      if ($required) {
	debug "required value at $name is absent";
	$self -> form_error ( 'required-absent', $name );
	$errors = 'yes';
      }
    }


  }  ### for each in @params

  if ( $errors ) {
    $self -> clear_process_queue;
  }
}








sub process_form_data {

  my $self = shift;
  
  my $variables = $self ->variables;
  my $screen    = $self -> request -> {screen};
  my $screen_config = $self -> config -> screen ($screen);
  my $params    = $screen_config -> {variables};
  
  foreach my $par ( @$params ) {

    my $name = $par -> {name};
    debug "apply parameter name = '" . $name . "', value = '" . 
      $self -> get_form_value ( $name ) . "'";
     
    next unless defined $par -> {place};
     
    debug "store to " . $par -> {place};
      
    my $data;
      
    my @places = split ',', $par -> {place};
      
    foreach my $to (@places) {
      my ($prefix, $place) = split ':', $to;

      if ( $prefix eq 'owner' ) {
	$data = $self -> session -> {'user-data'} {owner}; 
      
      } elsif ( $prefix eq 'record' ) { 
	$data = $self -> session -> current_record; 

      } elsif ( $prefix eq 'session' ) { 
	$data = $self -> session ; 

      } else { 
	die "error in screens configuration"; 
      } 

      my $val = $self -> get_form_value ($name);

      assign_path ( $data, $place, $val );
      
    }  
  }
}



#############  end of main form processing subs  ###




sub forgotten_password {

  my $app = shift;

  my $request  = $app -> request;
  my $home     = $app -> {home};
  my $vars     = $app -> variables;

  debug 'get login';
  
  my $query        = $request -> {'CGI'};
  my $query_params = scalar $query -> param;
 
  my $login  = $query -> param( 'login' ); 
 
  unless (defined $login and $login) {
    $app -> error ('login-unknown-user');
    $app -> clear_process_queue;
    return undef;
  }

  
  my $udata_file  = $app -> userdata_file_for_login( $login );

  if (not -f $udata_file) {
    # no such user 
    $app -> error ( 'login-unknown-user' );
    $app -> clear_process_queue;
    return undef;
  }

  debug "going to load user-data to find the password";

  my $udata = load ACIS::Web::UserData ( $udata_file );
  
  my $owner = $udata -> {owner};
  
  $app -> {'presenter-data'} {request} {user} = {
    name  => $owner -> {name},
    login => $owner -> {login},
    type  => $owner -> {type},
    pass  => $owner -> {password},
  };
  
  $app -> send_mail ( 'email/forgotten-password.xsl' );
  $app -> success( 1 );  ### XXX email/forgotten-password.xsl should check this

  $app -> message( 'forgotten-password-email-sent' );

  $app -> set_form_value ( 'login', $owner->{login} );
  $app -> set_form_action( $app -> config( 'base-url' ) );

  $app -> set_presenter ( 'login' );
}

1;
