package Bio::Graphics::Browser2::UserDB;

# $Id: UserDB.pm 23607 2010-07-30 17:34:25Z cnvandev $
use strict;
use Bio::Graphics::Browser2;
use Bio::Graphics::Browser2::SendMail;
use CGI qw(:standard);
use DBI;
use Digest::SHA qw(sha1_hex sha1);
use JSON;
use Text::ParseWords 'quotewords';
use Digest::MD5 qw(md5_hex);
use Carp qw(confess cluck croak);

use constant HAVE_OPENID => eval "require Net::OpenID::Consumer; require LWP::UserAgent; 1" || 0;
use constant HAVE_SMTP   => eval "require Net::SMTP;1" || 0;

# SOME CLARIFICATION ON TERMINOLOGY
# "userid"    -- internal dbm ID for a user; a short integer
# "sessionid" -- GBrowse's session ID, a long hexadecimal
# "uploadsid"  -- GBrowse's upload ID, a long hexadecimal

sub new {
  my $class   = shift;
  my $globals = shift;

  my $VERSION = '0.5';
  my $credentials  = $globals->user_account_db 
      || "DBI:mysql:gbrowse_login;user=gbrowse;password=gbrowse";
  
  my $login = DBI->connect($credentials);
  unless ($login) {
      confess "Could not open login database $credentials";
  }

  my $self = bless {
      dbi      => $login,
      globals  => $globals,
      openid   => HAVE_OPENID,
      register => HAVE_SMTP,
  }, ref $class || $class;

  return $self;
}

sub globals  {shift->{globals} };
sub dbi      {shift->{dbi}     };
sub can_openid   {shift->{openid}  };
sub can_register {shift->{register}  };

sub generate_salted_digest {
    my $self     = shift;
    my $password = shift;
    my $salt     = $self->create_key(4);
    return $salt . sha1_hex($salt,$password);
}

sub salted_digest_match {
    my $self   = shift;
    my ($offered,$correct) = @_;
    my ($salt,$digest) = $correct =~ /^(.{4})(.+)/;
    return sha1_hex($salt,$offered) eq $digest;
}

sub is_salted {
    my $self    = shift;
    my $correct = shift;
    return $correct =~ /^[a-zA-Z0-9_]{4}[0-9a-f]{40}$/;
}

sub passwd_match {
    my $self = shift;
    my ($offered,$correct) = @_;
    return $self->is_salted($correct) ? $self->salted_digest_match($offered,$correct)
	                              : sha1($offered) eq $correct;
}

# Get Header - Returns the message found at the top of all confirmation e-mails.
sub get_header {
  my $self = shift;
  my $globals = $self->{globals};
  my $message  = "\nThank you for creating an account with " 
      . $globals->application_name 
      . ": " 
      . $globals->application_name_long . "\n\n";
  $message .= "The account information found below is for your reference only. ";
  $message .= "Please keep all account names and passwords in a safe location ";
  $message .= "and do not share your password with others.";
  return $message;
}

# Get Footer - Returns the message found at the bottom of all e-mails.
sub get_footer {
  my $self = shift;
  my $globals = $self->{globals};
  my $message  = "Courtesy of " . $globals->application_name . " Administration\n\n";
     $message .= "This message and any attachments may contain confidential and/or ";
     $message .= "privileged information for the sole use of the intended recipient. ";
     $message .= "Any review or distribution by anyone other than the person for whom ";
     $message .= "it was originally intended is strictly prohibited. If you have ";
     $message .= "received this message in error, please contact the sender and delete ";
     $message .= "all copies. Opinions, conclusions or other information contained in ";
     $message .= "this message may not be that of the organization.";
  return $message;
}

# Create Key - Generates a random string of a given length.
sub create_key {
  my $self = shift;
  my $val = shift;
  my $key;
  my @char=('a'..'z','A'..'Z','0'..'9','_');
  foreach (1..$val) {$key.=$char[rand @char];}
  return $key;
}

# Check E-mail - Returns true if an e-mail is in a valid format.
sub check_email {
  my $self = shift;
  if(shift =~ m/^(\w|\-|\_|\&|\+|\.)+\@((\w|\-|\_)+\.)+[a-zA-Z]{2,}$/) {
    return 1;
  } else {
    return 0;
  }
}

# Check User - Returns true if a username is in a valid format.
sub check_user {
  my $self = shift;
  if(shift =~ m/^([!-\[]|[\]-~])+$/) {
    return 1;
  } else {
    return 0;
  }
}

#Check Admin - Returns true if a user is an admin.
sub check_admin {
  my $self = shift;
  my $username = shift;
  my $globals = $self->{globals};
  my $admin_name = $globals->admin_account;
  return unless $admin_name;
  return $username eq $admin_name;
}

# Check Old Confirmations - Deletes any unconfirmed accounts more than 3 days old.
sub check_old_confirmations {
  my $self = shift;
  my $nowfun = $self->nowfun();
  my $userdb = $self->{dbi};

  my $days = $self->globals->user_account_db =~ /sqlite/i ? "julianday('now')-julianday(last_login)"
                                                          : 'datediff(now(),last_login)';
  local $userdb->{AutoCommit} = 0;
  local $userdb->{RaiseError} = 1;
  eval {
      my $ids = $userdb->selectcol_arrayref("SELECT userid FROM users WHERE confirmed=0 AND $days>3");
      for my $id (@$ids) {
	  $userdb->do('DELETE FROM users   WHERE userid=?',undef,$id);
	  $userdb->do('DELETE FROM session WHERE userid=?',undef,$id);
      }
      $userdb->commit();
  };
  if ($@) {
      warn "deletion of expired new accounts failed due to '$@'. Rolling back.";
      eval {$userdb->rollback()};
  }
  return;
}

# Now Function - return the database-dependent function for determining current date & time
sub nowfun {
  my $self = shift;
  my $globals = $self->{globals};
  return $globals->user_account_db =~ /sqlite/i ? "datetime('now','localtime')" : 'now()';
}

#################### N O N - O P E N I D   F U N C T I O N S #####################
# Get User ID (User) - Returns a confirmed user's ID
sub get_user_id {
    my $self = shift;
    my $search = shift;
    # inefficient use of three separate SQL statements
    return $self->userid_from_username($search) || $self->userid_from_email($search) || $self->userid_from_fullname($search);
}

sub match_user {
    my $self   = shift;
    my $search = shift;

    my $userdb = $self->dbi;
    my $select = $userdb->prepare(<<END) or die $userdb->errstr;
SELECT a.username,b.gecos,b.email 
  FROM session as a,users as b
 WHERE a.userid=b.userid
   AND (a.username LIKE ? OR
        b.gecos    LIKE ? OR
        b.email    LIKE ?)
END
;
    $search = quotemeta($search);
    my $db_search = "%$search%";
    $select->execute($db_search,$db_search,$db_search) or die $select->errstr;
    my @results;
    while (my @a = $select->fetchrow_array) {
	push @results, ($a[2] && $a[2] !~ /unused/i ? "$a[1] &lt;$a[2]&gt; ($a[0])" : "$a[1] ($a[0])");
    }
    $select->finish;
    return \@results;
}

 # similar to match_user() except that it only finds users who are sharing files
sub match_sharing_user {
    my $self   = shift;
    my ($source,$search) = @_;
    my $userdb = $self->dbi;
    my $select = $userdb->prepare(<<END) or die $userdb->errstr;
SELECT a.username,b.gecos,b.email 
  FROM session as a,users as b,uploads as c
 WHERE a.userid=b.userid
   AND a.userid=c.userid
   AND c.sharing_policy='public'
   AND c.data_source=?
   AND (a.username LIKE ? OR
        b.gecos    LIKE ? OR
        b.email    LIKE ?)
END
;
    $search = quotemeta($search);
    my $db_search = "%$search%";
    $select->execute($source,$db_search,$db_search,$db_search) or die $select->errstr;
    my @results;
    while (my @a = $select->fetchrow_array) {
	push @results,(grep /$search/i,@a);
    }
    $select->finish;
    return \@results;
}

sub userid_from_username {
    my $self     = shift;
    my $username = shift;

    my $userdb = $self->{dbi};
    my ($user_id) = 
	$userdb->selectrow_array(<<END ,undef,$username);
SELECT userid
  FROM session as a
  WHERE a.username=?
  LIMIT 1
END
return $user_id;
}

sub userid_from_email {
    my $self     = shift;
    my $email = shift;

    my $userdb = $self->{dbi};
    my ($user_id) = 
	$userdb->selectrow_array(<<END ,undef,$email);
SELECT userid
  FROM users as a
  WHERE a.email=?
  LIMIT 1
END
;
    return $user_id;
}

sub userid_from_fullname {
    my $self     = shift;
    my $email = shift;

    my $userdb = $self->{dbi};
    my ($user_id) = 
	$userdb->selectrow_array(<<END ,undef,$email);
SELECT userid
  FROM users as a
  WHERE a.gecos=?
  LIMIT 1
END
;
    return $user_id;
}

sub userid_from_uploadsid {
    my $self      = shift;
    my $uploadsid = shift;

    my $userdb = $self->{dbi};
    my $user_id = 
	$userdb->selectrow_array(<<END ,undef,$uploadsid);
SELECT userid
  FROM session as a
  WHERE a.uploadsid=?
  LIMIT 1
END
}

sub set_fullname_from_username {
    my $self = shift;
    my ($username,$fullname,$email) = @_;
    my $userdb = $self->dbi;

    my $userid = $self->userid_from_username($username) or return;

    local $userdb->{AutoCommit} = 0;
    local $userdb->{RaiseError} = 1;
    eval {
	my ($rows) = $userdb->selectrow_array(<<END,undef,$userid);
SELECT count(*) FROM users WHERE userid=?
END
;
	if ($rows > 0) {
	    $userdb->do('UPDATE users SET gecos=?,email=? WHERE userid=?',undef,$fullname,$email||'',$userid);
	} else {
	    my $nowfun = $self->nowfun();
	    my $email  = $email || ('unused_'.$self->create_key(32).'@nowhere.net');
	    $userdb->do(<<END,undef,$userid,$fullname,$email);
INSERT INTO users(userid,gecos,email,pass,remember,openid_only,confirmed,cnfrm_code,last_login,created)
VALUES (?,?,?,'x',1,1,1,'x',$nowfun,$nowfun)
END
;
	}
	$userdb->commit();
    };
    if ($@) {
	warn "Setting fullname for $username failed due to $@. Rolling back.";
	eval {$userdb->rollback()};
    }
}

sub sessionid_from_username {
    my $self = shift;
    my $username = shift;
    my $userdb   = $self->{dbi};
    my $sessionid = $userdb->selectrow_array(<<END ,undef,$username);
SELECT sessionid
  FROM session as a
  WHERE a.username=?
  LIMIT 1
END
;
    return $sessionid;
}

# Username From UploadsID (Uploads ID) - Returns a user's name.
sub username_from_uploadsid {
    my $self      = shift;
    my $uploadsid = shift;

    my $userdb = $self->{dbi};
    my $user_id = 
	$userdb->selectrow_array(<<END ,undef,$uploadsid);
SELECT username
  FROM session as a
  WHERE a.uploadsid=?
  LIMIT 1
END
}

# Get Uploads ID (User ID) - Returns a user's Uploads ID.
sub get_uploads_id {
    my $self = shift;
    my $userid = shift;
    my $userdb = $self->{dbi};
    return $userdb->selectrow_array("SELECT uploadsid FROM session WHERE userid=?",
				    undef,$userid);
}

sub get_sessionid {
    my $self = shift;
    my $userid = shift;
    my $userdb = $self->{dbi};
    return $userdb->selectrow_array("SELECT sessionid FROM session WHERE userid=?",
				    undef,$userid);
}

sub accountinfo_from_username {
    my $self     = shift;
    my $username = shift;
    my $userdb = $self->dbi;
    return $userdb->selectrow_array('SELECT a.gecos,a.email FROM users as a,session as b WHERE a.userid=b.userid AND b.username=?',
				    undef,$username);
}

# Get Username (User ID) - Returns a user's username, given their ID.
sub get_username {
    croak "you probably want to call username_from_sessionid";
}

sub username_from_userid {
    my $self = shift;
    my $userid = shift;
    my $userdb = $self->{dbi};
    return $userdb->selectrow_array("SELECT username FROM session WHERE userid=?", undef, $userid) || 'an anonymous user';
}

sub username_from_sessionid {
    my $self = shift;
    my $sessionid = shift;
    my $userdb = $self->{dbi};

    return $userdb->selectrow_array(<<END ,undef,$sessionid)||'an anonymous user';
SELECT username FROM session
 WHERE sessionid=?
END
}

sub fullname_from_sessionid {
    my $self = shift;
    my $sessionid = shift;
    my $userdb = $self->{dbi};

    my ($fullname,$username) = $userdb->selectrow_array(<<END ,undef,$sessionid);
SELECT b.gecos,a.username 
  FROM session as a,users as b
 WHERE a.userid=b.userid
   AND a.sessionid=?
END
;
    return $fullname || $username; # fallback to username if fullname not available
}

sub email_from_sessionid {
    my $self = shift;
    my $sessionid = shift;
    my $userdb = $self->{dbi};

    my ($email) = $userdb->selectrow_array(<<END ,undef,$sessionid);
SELECT b.email
  FROM session as a,users as b
 WHERE a.userid=b.userid
   AND a.sessionid=?
END
;
    return $email;
}

sub userid_from_sessionid {
    my $self = shift;
    my $sessionid = shift;
    my $userdb = $self->{dbi};

    my ($userid) = $userdb->selectrow_array(<<END ,undef,$sessionid);
SELECT userid FROM session
 WHERE sessionid=?
END
    ;
    return $userid;
}

sub set_confirmed_from_username {
    my $self = shift;
    my $username = shift;
    my $userdb = $self->dbi;
    my $userid = $self->userid_from_username($username) or return;
    return $userdb->do('UPDATE users SET confirmed=1 WHERE userid=?',undef,$userid);
}

# Check Uploads ID (User ID, Uploads ID) - Makes sure a user's ID is in the database.
sub check_uploads_id {
    my $self = shift;
    croak "check_uploads_id() should no longer be necessary";
    my ($sessionid,$uploadsid) = @_;
    my $userdb = $self->{dbi};

    my $rows = $userdb->selectrow_array(<<END ,undef,$sessionid,$uploadsid);
SELECT count(*) FROM session
   WHERE sessionid=? and uploadsid=?
END
    unless ($rows) {
        $userdb->do(<<END ,undef,$sessionid,$uploadsid);
INSERT INTO session (sessionid,uploadsid)
     VALUES (?,?)
END
;
    }
    return $uploadsid;
}

sub check_or_add_named_session {
    my $self = shift;
    my ($sessionid,$username) = @_;
    if (my $old_session = $self->sessionid_from_username($username)) {
	return $old_session;
    } else {
	$self->add_named_session($sessionid,$username);
	return $sessionid;
    }
}

sub add_named_session {
    my $self = shift;
    my ($sessionid,$username) = @_;

    my $userdb  = $self->dbi;

    my $session = $self->globals->session($sessionid);
    $session->id eq $sessionid or die "Sessionid unavailable";
    my $uploadsid = $session->uploadsid;

    my $insert_session  = $userdb->prepare(<<END );
REPLACE INTO session (username,sessionid,uploadsid)
     VALUES (?,?,?)
END
    ;
    
    $insert_session->execute($username,$sessionid,$uploadsid)
	or return;
    return $userdb->last_insert_id('','','','');
}

sub set_session_and_uploadsid {
    my $self = shift;
    my ($userid,$sessionid,$uploadsid) = @_;

    my $userdb = $self->dbi;
    $userdb->do('UPDATE session SET sessionid=?,uploadsid=? WHERE userid=?',
		undef,
		$sessionid,$uploadsid,$userid) or die $userdb->errstr;
}

sub delete_user_by_username {
    my $self = shift;
    my $username = shift;
    my $userdb = $self->dbi;
    my $userid = $self->userid_from_username($username) or return;
    local $userdb->{AutoCommit} = 0;
    local $userdb->{RaiseError} = 1;
    eval {
	$userdb->do('DELETE FROM users        WHERE userid=?',undef,$userid);
	$userdb->do('DELETE FROM session      WHERE userid=?',undef,$userid);
	$userdb->do('DELETE FROM openid_users WHERE userid=?',undef,$userid);
	$userdb->do('DELETE FROM uploads      WHERE userid=?',undef,$userid);
	$userdb->do('DELETE FROM sharing      WHERE userid=?',undef,$userid);
	$userdb->commit();
    };
    if ($@) {
	warn "Account deletion failed due to $@. Rolling back.";
	eval {$userdb->rollback()};
    }
    1;
}

#####################################
# BUG!
# Everything below here supports the
# login.js script, which expects return
# values as various combinations of
# strings and JSON structures.
# This means API is strongly tied
# to database queries.
#####################################

# Validate - Ensures that a non-openid user's credentials are correct.
sub do_validate {
  my $self = shift;
  my ($user,$pass,$remember) = @_;
  
  my $userdb = $self->{dbi};
  my $update;

  # remove dangling unconfirmed accounts here
  $self->check_old_confirmations();

#  return $self->string_result('Usernames cannot contain any backslashes, whitespace or non-ascii characters.')
  return $self->code_result('INVALID_NAME'=>'Usernames cannot contain any backslashes, whitespace or non-ascii characters.')
      unless $self->check_user($user);

  my $userid = $self->userid_from_username($user);
  my $nowfun = $self->nowfun();

  # WARNING: bad design here
  # EXPLANATION: a remember value of "2" means to update last_login
  # but not to retrieve session ID. This seems to be requested during account
  # editing/updating.
  if($remember == 2) {
      $update = $userdb->prepare(
	  "UPDATE users SET last_login=$nowfun WHERE userid=? AND confirmed=1");
  } else {
      $update = $userdb->prepare(
	  "UPDATE users SET last_login=$nowfun,remember=$remember WHERE userid=? AND confirmed=1");
  }

  my $select = $userdb->prepare(
      "SELECT sessionid,email,confirmed,pass FROM users as a,session as b WHERE a.userid=b.userid and a.userid=?");
  $select->execute($userid)
      or return $self->dbi_err;

  # BUG: this is truly nasty -- the session id is found by string searching in login.js!!!!
  my ($session,$email,$confirmed,$correct_pass) = $select->fetchrow_array;

  if ($session && $self->passwd_match($pass,$correct_pass)) {
      if ($confirmed) {
	  my $result = $remember == 2 ? 'Success' : "session".$session;
	  return $self->string_result($result);
      } else {
	  return $self->string_result("unconfirmed${email}");
      }
  } else {
      return $self->string_result('Invalid username or password provided, please try again.'); 
  }

  # update time login now
  $update->execute($userid)
      or return $self->dbi_err;
}

# Add User Check - Checks to see if the user has already been added.
sub do_add_user_check {
  my $self = shift;
  my ($user,$email,$fullname,$pass,$userid) = @_;
  
  my $userdb = $self->dbi;
  
  return $self->string_result('Invalid e-mail address (',$email,') provided.')
      unless $self->check_email($email);
  
  return $self->string_result("Usernames cannot contain any backslashes, whitespace or non-ascii characters.")
      unless $self->check_user($user);

  my $select = $userdb->prepare(
    "SELECT confirmed FROM users WHERE email=?");
  $select->execute($email)
      or return $self->dbi_err;

  my $confirmed = $select->fetchrow_array;
  if($select->rows == 0) {
      return $self->do_add_user($user,$email,$fullname,$pass,$userid);
  } elsif($confirmed == 1) {
      return $self->string_result('E-mail in use');
  } elsif($confirmed == 0) {
      return $self->string_result('Message Already Sent');
  }

  return $self->programmer_error;
}

# Add User - Adds a new non-openid user to the user database.
sub do_add_user {
  my $self = shift;
  my ($user,$email,$fullname,$pass,$sessionid,$allow_admin) = @_;

  # for debugging front end, uncomment as needed
#  return $self->string_result('Session Error');
#  return $self->string_result('Username already in use, please try another.');
#    return $self->string_result("Invalid e-mail address (",$email,") provided.");
#  return $self->string_result('Success');
  
  my $userdb = $self->dbi;
  
  return $self->string_result("Invalid e-mail address (",$email,") provided.")
      unless $self->check_email($email);

  return $self->string_result('Usernames cannot contain any backslashes, whitespace or non-ascii characters.')
      unless $self->check_user($user);
		  
  return $self->string_result("Invalid username. Try a different one.")
      if !$allow_admin && $self->check_admin($user);

  # see if this username is already taken
  return (200,'text/plain','Username already in use, please try another.')
      if $self->userid_from_username($user);

  my $confirm = $self->create_key('32');
  my $nowfun = $self->nowfun();

  local $userdb->{AutoCommit} = 0;
  local $userdb->{RaiseError} = 1;
  eval {
      my $userid = $self->add_named_session($sessionid,$user) 
	  or return $self->dbi_err;

      my $insert_userinfo = $userdb->prepare (<<END );
INSERT INTO users (userid, gecos, email, pass, remember, openid_only, 
		   confirmed, cnfrm_code, last_login, created)
     VALUES (?,?,?,?,0,0,0,?,$nowfun,$nowfun)
END
;
      my $sha_pass = $self->generate_salted_digest($pass);
      $insert_userinfo->execute($userid,$fullname,$email,$sha_pass,$confirm)
	  or return $self->dbi_err;
      $userdb->commit();
  };
  if ($@) {
      warn "user account insertion failed due to $@. Rolling back.";
      eval {$userdb->rollback()};
      if(DBI->errstr =~ m/for key 1$/      || DBI->errstr =~ m/username is not unique/) {
	  return $self->string_result("Username already in use, please try another.");
      } elsif(DBI->errstr =~ m/for key 2$/ || DBI->errstr =~ m/email is not unique/) {
	  return $self->string_result("E-mail address already in use, please provide another.");
      } elsif(DBI->errstr =~ m/for key 3$/ || DBI->errstr =~ m/userid is not unique/) {
	  return $self->string_result("Session Error");
      } else {
	  return $self->dbi_err;
      }
  }
  
  else {
      return $self->do_send_confirmation($email,$confirm,$user,$pass);
  }

    return $self->programmer_error;
}

# Send Confirmation - Sends an e-mail when a user creates a new non-openid account to ensure that the user is valid and the e-mail exists.
sub do_send_confirmation {
  my $self = shift;
  my ($email,$confirm,$user,$pass) = @_;

  my $globals = $self->{globals};
  my $link = $globals->gbrowse_url()."/?confirm=1&code=$confirm";

  my $message  = '<HTML><BODY>'.$self->get_header();
  $message    .= <<END;
  <p>
  <table>
      <tr><th align="right">Username</th><td>$user</td></tr>
      <tr><th align="right">Password</th><td>$pass</td></tr>
      <tr><th align="right">Email</th><td>$email</td></tr>
   </table>
   </p>
   <p>
   To activate your account and complete the sign up process, please click
   on the following link: <a href="$link">$link</a>
   </p>
END
     $message .= '<p style="font-size:small">'.$self->get_footer().'</p></BODY></HTML>';

  my ($status,$err) = $self->Bio::Graphics::Browser2::SendMail::do_sendmail({
     from       => $globals->email_address,
     from_title => $globals->application_name,
     to         => $email,
     subject    => $globals->application_name . " Account Activation",
     msg        => $message,
     HTML       => 1,
  },$globals);
  unless ($status) {
      warn $err;
       return $self->string_result('Mail Error');
  }
  return $self->string_result('Success');
}

# Edit Confirmation - Deletes or resends unconfirmed information based on "option"
sub do_edit_confirmation {
  my $self = shift;
  my ($email,$option) = @_;
  
  my $userdb = $self->{dbi};

  my $select = $userdb->prepare(<<END );
SELECT b.username, a.userid, b.sessionid, a.gecos, a.cnfrm_code
    FROM users as a,session as b 
    WHERE a.email=? AND a.userid=b.userid AND a.confirmed=0
END
  $select->execute($email)
    or return $self->dbi_err;
  my ($username,$userid,$sessionid,$fullname, $confirm) = $select->fetchrow_array();

  unless ($username) {
      return $self->string_result("Invalid username $username");
  }

  if ($option == 0) { # delete account!
      eval {
	  local $userdb->{AutoCommit} = 0;
	  local $userdb->{RaiseError} = 1;
	  $userdb->do("DELETE FROM users        WHERE userid=?",undef,$userid);
	  $userdb->do("DELETE FROM openid_users WHERE userid=?",undef,$userid);
	  $userdb->do("DELETE FROM session      WHERE userid=?",undef,$userid);
	  $userdb->commit();
      };
      if ($@) {
	  eval {$userdb->rollback()};
	  return $self->string_result($@);
      } else {
	  return $self->string_result("Your account has been successfully removed.");
      }
  }

  elsif ($option == 1) {
      my $pass = '******';
      return $self->do_send_confirmation($email,$confirm,$username,$pass);
      # return $self->string_result("Success");
  }

  return $self->programmer_error;
}

# Confirm Account - Activates a new account when the user follows the mailed link.
sub do_confirm_account {
  my $self = shift;
  my ($user,$confirm) = @_;
  my $userdb = $self->{dbi};

  my $new_confirm = sha1_hex($confirm);

  my ($rows) = $userdb->selectrow_array(
    "SELECT count(*) FROM users WHERE cnfrm_code=? AND confirmed=0",
    undef,
    $confirm);

  return $self->string_result('Already Active') unless $rows == 1;

  my $userid = $self->userid_from_username($user);

  my $update = $userdb->prepare(
    "UPDATE users SET confirmed=1,cnfrm_code=? WHERE userid=? AND cnfrm_code=? AND confirmed=0");
  $update->execute($new_confirm,$userid,$confirm)
    or return $self->dbi_err;

  $rows = $update->rows;
  if ($rows == 1) {
    my $query = $userdb->prepare(
      "SELECT b.sessionid FROM users as a,session as b WHERE b.username=? AND a.userid=b.userid AND cnfrm_code=? AND confirmed=1");

    $query->execute($user,$new_confirm)
      or return $self->dbi_err;

    return $self->string_result($query->fetchrow_array());
  } elsif($rows == 0) {
      return $self->string_result("Error: Incorrect username provided, please check your spelling and try again.");
  } else {
      return $self->string_result("Error: $rows rows returned, please consult your service host.");
  }
  return;
}

# Edit Details - Updates the user's e-mail or password depending on the "column"
sub do_edit_details {
    my $self = shift;
    my ($user,$column,$old,$new,$session) = @_;
    my $userdb = $self->dbi;
    my $userid = $self->userid_from_username($user)
	or return $self->string_result("Error: unkown user $user");

    $session->private && $session->username eq $user
	or return $self->string_result('Error: Apparent attempt to change details for another user');
    
    if($column eq 'email') {
	return $self->string_result("New e-mail address is invalid, please try another.")
	    unless $self->check_email($new);
    }

    if ($column eq 'pass') {
	my ($pass) = $userdb->selectrow_array('SELECT pass FROM users WHERE userid=?',undef,$userid);
	unless ($self->passwd_match($old,$pass)) {
	    return $self->string_result("Incorrect password provided, please check your spelling.");
	}
	$new = $self->generate_salted_digest($new);
	$old = $pass;
    }

    my $querystring  = "UPDATE users       ";
    $querystring .= "   SET $column  = ?";
    $querystring .= " WHERE userid   = ?";

    my $update = $userdb->prepare($querystring);
    unless($update->execute($new,$userid)) {
	if ($column eq 'email') {
	    return $self->string_result("New e-mail already in use, please try another.");
	} else {
	    return $self->dbi_err;
	}
    }

    if (DBI->errstr =~ m/for key 3$/) {
	return $self->string_result("New e-mail already in use, please try another.");
    }

    my $rows = $update->rows;
    if($rows == 1) {
	return $self->string_result("Success");
    } elsif ($rows == 0) {
	my $explanation = $column eq 'pass'  ? 'password' 
	                 :$column eq 'email' ? 'email address'
			 :'information';
	return $self->string_result("Incorrect $explanation provided, please check your spelling.");
    } else {
	if(($column eq 'email') and ($rows == -1)) {
	    return $self->string_result("New e-mail already in use, please try another.");
	} else {
	    return $self->string_result("Error: $rows rows returned, please consult your service host.");
	}
    }
    return $self->programmer_error;
}
  
# E-mail Info - Sends an e-mail when a user has forgotten their password.
sub do_email_info {
  my $self = shift;
  my $email = shift;
  my $globals = $self->{globals};
  my $userdb = $self->{dbi};
  
  return $self->string_result("Invalid e-mail address provided.")
      unless $self->check_email($email);

  my ($user,$rows,$openid_ref) = $self->do_retrieve_user($email);
  my @openids = @$openid_ref;
  my $openid  = "";
  
  return $self->string_result($user) unless $rows == 1;

  if (@openids) {foreach(@openids) {$openid .= "$_\n             ";}}
  else {$openid = "None\n";}

  my $pass = $self->create_key('8');
  my $message  = "\nYour password has been reset to the one seen below. To fix this,";
     $message .= " select \"My Account\" from the log in menu and log in with the";
     $message .= " credentials found below.\n\n    Username: $user\n    ";
     $message .= "Password: $pass\n\n    OpenIDs: $openid\n\n";
     $message .= $self->get_footer();

  my ($status,$err) = $self->Bio::Graphics::Browser2::SendMail::do_sendmail({
			     from       => $globals->email_address,
			     from_title => $globals->application_name,
			     to         => $email,
			     subject    => $globals->application_name . " Account Information",
			     msg        => $message
			    },$globals);
  return $self->string_result($err) unless $status;

  my $secret = $self->generate_salted_digest($pass);
  my $update = $userdb->prepare(
    "UPDATE users SET pass=? WHERE userid=? AND email=? AND confirmed=1");
  my $userid = $self->userid_from_username($user);
  $update->execute($secret,$userid,$email)
    or return $self->dbi_err;

  return $self->string_result('Success');
}

sub set_password {
    my $self = shift;
    my ($userid,$password) = @_;
    my $userdb   = $self->dbi;
    my $secret = $self->generate_salted_digest($password);
    my $update = $userdb->prepare(
	"UPDATE users SET pass=? WHERE userid=?") or die $userdb->errstr;
    my $status = $update->execute($secret,$userid) or die $userdb->errstr;
    return $status;
}

# Retrieve User - Gets the username associated with a given e-mail.
sub do_retrieve_user {
  my $self = shift;
  my $email = shift;
  
  my $userdb = $self->{dbi};
  
  my @openids;

  my $users = $userdb->selectcol_arrayref(
    "SELECT username FROM users as a,session as b WHERE a.userid=b.userid AND email=? AND confirmed=1",
  	undef,
  	$email)
  or return $self->dbi_err;

  my $rows = @$users;
  if ($rows == 1) {
    my $user  = $users->[0];
    my $query = $userdb->prepare(
      "SELECT openid_url FROM openid_users,session WHERE openid_users.userid=session.userid and session.username=?");
    $query->execute($user)
      or return $self->dbi_err;

    while (my $openid = $query->fetchrow_array) {
      push (@openids,$openid);
    }

    return ($user,$rows,\@openids);
  } elsif($rows == 0) {
    return ("Sorry, an account does not exist for the e-mail provided.",$rows,\@openids);
  } else {
    return ("Error: $rows accounts match your e-mail, please consult your service host.",$rows,\@openids);
  }
}

# Delete User - Removes a user from the database.
sub do_delete_user {
  my $self = shift;
  my ($user, $pass) = @_;
  
  my $userdb = $self->dbi;
  my $userid = $self->userid_from_username($user);
  return $self->string_result("Error: unknown user $user") unless $userid;

  my $sessionid = $self->get_sessionid($userid);
  $userdb->do('DELETE FROM session where userid=?',undef,$userid);
  my $session = $self->globals->session($sessionid);
  $session->delete;
  $session->flush;

  $userdb->do('DELETE FROM users WHERE userid=?',undef,$userid);

  my $query = $userdb->prepare(
    "DELETE FROM openid_users WHERE userid=?");
  if ($query->execute($userid)) {
      return $self->string_result('Success');
  } else {
      return $self->dbi_err;
  }
  return;
}

######################## O P E N I D   F U N C T I O N S #########################
# Check OpenID - Sends a user to their openid host for confirmation.

# BUG: ALL THE OPENID FUNCTIONS NEED TO BE REVISED
sub do_check_openid {
    my $self = shift;
    my $globals = $self->{globals};
    my ($openid, $sessionid, $source, $option) = @_;
    
    my $return_to  = $globals->gbrowse_url($source)."/?openid_confirm=1;page=$option;s=$sessionid";

    my $csr = Net::OpenID::Consumer->new(
        ua              => LWP::UserAgent->new,
        args            => CGI->new,
        consumer_secret => Bio::Graphics::Browser2->openid_secret,
        required_root   => "http://$ENV{'HTTP_HOST'}/"
    );

    my $claimed_identity = $csr->claimed_identity($openid)
        or return $self->string_result("The URL provided is not a valid OpenID, please check your spelling and try again.");
    
    my $check_url = $claimed_identity->check_url(
        return_to  => $return_to,
        trust_root => "http://$ENV{'HTTP_HOST'}/",
        delayed_return => 1
    );
    # request information about email address and full name
    $check_url .= "&openid.ns.ax=http://openid.net/srv/ax/1.0&openid.ax.mode=fetch_request&openid.ax.required=email,firstname,lastname&openid.ax.type.email=http://axschema.org/contact/email&openid.ax.type.firstname=http://axschema.org/namePerson/first&openid.ax.type.lastname=http://axschema.org/namePerson/last";

    # this shouldn't work, but oddly it does.
    # it has something to do with prototype ajax and the Location: string
    return (200,'text/html',"Location: $check_url"); # shouldn't work?

    # this should work, but oddly it doesn't
    # return (302,undef,$check_url);

}

# Confirm OpenID - Checks that the returned credentials are valid.
sub do_confirm_openid {
    my $self = shift;
    my ($callbacks, $sessionid, $option,$email,$fullname) = @_;
    
    my $userdb = $self->{dbi};
    
    my ($error, @results, $select, $user, $only);

    my $csr = Net::OpenID::Consumer->new(
        ua              => LWP::UserAgent->new,
        args            => $callbacks,
        consumer_secret => Bio::Graphics::Browser2->openid_secret,
        required_root   => "http://$ENV{'HTTP_HOST'}/"
    );

    if ($option eq "openid-add") {
        ($user, $only) = $userdb->selectrow_array(
	    "SELECT b.username,a.openid_only FROM users as a,session as b WHERE b.sessionid=? AND a.userid=b.userid",
	    undef,
	    $sessionid)
	    or return(200,'application/json',[{error=>'Error: '.$userdb->errstr.'.'}]);
        unless (defined $user) {
            push @results,{error=>"Error: Wrong session ID provided, please try again."};
            return (200,'application/json',\@results);
        }
    }

    $csr->handle_server_response(
        not_openid => sub {
            push @results,{user=>$user,only=>$only,error=>"Invalid OpenID provided, please check your spelling."};
        },
        setup_required => sub {
            push @results,{user=>$user,only=>$only,error=>"Error: Your OpenID requires setup."};
        },
        cancelled => sub {
            push @results,{user=>$user,only=>$only,error=>"OpenID verification cancelled."};
        },
        verified => sub {
            my $vident = shift;
            if($option eq "openid-add") {
		push @results,$self->do_add_openid_to_account($sessionid, $user, $vident->url, $only)
            } else {
		push @results,$self->do_get_openid($vident->url,$email,$fullname);
            }
        },
        error => sub {
            $error = $csr->err;
            push @results,{user=>$user,only=>$only,error=>"Error validating identity: $error."};
        }
    );
    return (200,'application/json',\@results);
}

sub do_get_gecos {
    my $self = shift;
    my $user = shift;
    my $sessionid = $self->sessionid_from_username($user) or return '';
    my $fullname = $self->fullname_from_sessionid($sessionid);
    return $self->string_result($fullname);
}

sub do_get_email {
    my $self = shift;
    my $user = shift;
    my $sessionid = $self->sessionid_from_username($user) or return '';
    my $fullname = $self->email_from_sessionid($sessionid);
    return $self->string_result($fullname);
}

# Get OpenID - Check to see if the provided openid is unused
sub do_get_openid {
    my $self   = shift;
    my ($openid,$email,$fullname) = @_;

    my $userdb = $self->{dbi};
    
    my $error;

    my $from = <<END;
FROM users as A, openid_users as B, session as C
 WHERE A.userid     = B.userid
   AND A.userid     = C.userid
   AND A.confirmed  = 1
   AND B.openid_url = ?
END
;
    my ($rows) = $userdb->selectrow_array(
	"select count(*) $from",
	undef,
	$openid)
	or return {error=>'Error: '.$userdb->errstr.'.'};

    if($rows != 1) {
        if($rows == 0) {
            $error  = "The OpenID provided has not been used before. ";
            $error .= "Please create an account first before trying to edit your information.";
        } else {
            $error  = "Error: $rows rows returned, please consult your service host.";
        }
        return {error=>$error,openid=>$openid,email=>$email,fullname=>$fullname};
    }

    my $select = $userdb->prepare("SELECT C.username, C.sessionid, A.remember, A.openid_only, A.userid $from");
    $select->execute($openid)
	or return {error=>'Error: '.$select->errstr.'.'};

    my @info = $select->fetchrow_array;

    my $nowfun = $self->nowfun();
    my $update = $userdb->prepare(
        "UPDATE users SET last_login=$nowfun WHERE userid=? AND confirmed=1");
    $update->execute($info[4])
	or return {error=>'Error: '.$update->errstr.'.'};

    return {user=>$info[0],session=>$info[1],remember=>$info[2],only=>$info[3]};
}

# Change OpenID - Add or removes an openid from an account based on "option"
sub do_change_openid {
    my $self = shift;
    my ($user, $pass, $openid, $option) = @_;

    my $userdb = $self->dbi;
    my $users = $userdb->selectrow_arrayref('SELECT a.userid FROM users as a,session as b WHERE b.username=? AND a.userid=b.userid',
					    undef,$user)
        or return $self->dbi_err;
    my $rows = @$users;

    return $self->string_result("Error: unknown user $user.") unless $rows == 1;

    if ($option eq "add") {
        return $self->do_check_openid($openid, $users->[0],"openid-add");
    }

    # if we get here, we are deleting
    my ($correct_pass) = $userdb->selectrow_array('SELECT a.pass FROM users as a WHERE a.userid=?',undef,$users->[0])
	or return $self->dbi_err;
    
    $self->passwd_match($pass,$correct_pass)
	or return $self->string_result('Invalid password. Please try again.');

    my $delete = $userdb->prepare(<<END );
DELETE FROM openid_users
      WHERE openid_url=?
        AND userid IN (
                   SELECT a.userid
                     FROM openid_users as a,session as b
                    WHERE a.userid=b.userid
                      AND b.username=?
            )
END
;
    if ($delete->execute($openid,$user)) {
	return $self->string_result('Success');
    } else {
        if(DBI->errstr =~ m/for key 1$/) {
	    return $self->string_result("The OpenID provided is already in use, please try another.");
        } else {
	    return $self->dbi_err;
        }
    }
    return $self->programmer_error;
}

# Add OpenID to Account (UserID, Username, OpenID, Only(?)) - Adds a confirmed openid to an account.
sub do_add_openid_to_account {
    my $self = shift;
    my ($sessionid, $user, $openid, $only) = @_;
    
    my $userdb = $self->{dbi};
    my $error;

    my $userid = $self->userid_from_sessionid($sessionid)
	or return {user=>$user,only=>$only,error=>"Error: No userid associated with the current session"};
    
    my $insert = $userdb->prepare("INSERT INTO openid_users (userid,openid_url) VALUES (?,?)");
    if($insert->execute($userid, $openid)) {
        $error = "Success";
    } else {
        if(DBI->errstr =~ m/for key 1$/) {
            $error = "The OpenID provided is already in use, please try another.";
        } else {
            $error = "Error: ".DBI->errstr.".";
        }
    }
    return {user=>$user,only=>$only,error=>$error};
}

# Add OpenID User (Username, Email, Gecos(fullname), OpenID, UserID, Remember?) - Adds a new openid user to the user database.
sub do_add_openid_user {
    my $self = shift;
    my ($user, $email, $gecos, $openid, $sessionid, $remember) = @_;

    my $userdb = $self->{dbi};

    return $self->string_result("Usernames cannot contain any backslashes, whitespace or non-ascii characters.")
	unless $self->check_user($user);

    my $confirm = sha1_hex($self->create_key('32'));
    my $pass    = $self->generate_salted_digest($self->create_key('32'));

    my $nowfun  = $self->nowfun();

    local $userdb->{AutoCommit} = 0;
    local $userdb->{RaiseError} = 1;
    eval {
	my $userid  = $self->add_named_session($sessionid,$user)
	    or return $self->dbi_err;
	    
	my $query  = $userdb->prepare(<<END );
INSERT INTO users (userid,email,gecos,pass,remember,openid_only,confirmed,cnfrm_code,last_login,created) 
     VALUES (?,?,?,?,?,1,1,?, $nowfun, $nowfun)
END
;

	$query->execute($userid, $email, $gecos, $pass, $remember, $confirm)
	    or return $self->dbi_err;

	my $insert = $userdb->prepare("INSERT INTO openid_users (userid,openid_url) VALUES (?,?)");
	$insert->execute($userid, $openid) or die "Couldn't insert url into openid_users table: ",$insert->errstr;

	$userdb->commit();
    };

    if ($@) {
	warn "openid user account insertion failed due to $@. Rolling back.";
	my $err = $@;
	eval {$userdb->rollback()};

	if($err =~ m/for key 1$/) {
	    return $self->string_result("The OpenID provided is already in use, please try another.");
	}
	elsif ($err =~ m/for key 1$/ || DBI->errstr =~ m/for key 3$/) {
            #If the e-mail happens to match another, this will still be called.
	    return $self->string_result("Username already in use, please try another.");
        } elsif($err =~ m/for key 2$/) {
	    return $self->string_result("Session Error");
        } else {
	    return $self->dbi_err($err);
        }
    }
    else {
	return $self->string_result('Success');
    }
    return $self->programmer_error;
}

# List OpenID (User) - Generates a list of openids associated with a user's account.
sub do_list_openid {
    my $self = shift;
    my $user = shift;
    my ($error,@openids);
    my $userdb = $self->{dbi};

    my $select = $userdb->prepare(
        "SELECT a.openid_url FROM openid_users as a,session as b WHERE b.username=? AND a.userid=b.userid");
    $select->execute($user) or return (200,'application/json',[{error=>'Error: '.$userdb->errstr.'.'}]);

    while (my $openid = $select->fetchrow_array) {
        push @openids,{name=>$openid};
    }

    unless (@openids) {
        push @openids,{error=>"There are no OpenIDs currently associated with this account."}
    }

    my @results = sort {$a->{name} cmp $b->{name}} @openids;
    return(200,'application/json',\@results);
}

# convenience methods
sub dbi_err {
    my $self = shift;
    my $err  = shift;
    my $error = $err || DBI->errstr;
    $error    =~ s/at.+line \d+//;
    return (200,'text/plain',"Error: $error");
}

sub code_result {
    my $self = shift;
    my ($code,@msg) = @_;
    return (200,'application/json',{code=>$code,message=>join('',@msg)});
}
sub string_result {
    my $self = shift;
    my @msg  = @_;
    return (200,'text/plain',join('',@msg));
}

sub programmer_error {
    my $self = shift;
    return (500,'text/plain','programmer error?');
}

# Remember (User) - Get's a user's remember flag.
sub remember {
    my $self = shift;
    my $userid = shift;
    my $userdb = $self->{dbi};
    return $userdb->selectrow_array("SELECT remember FROM users WHERE userid = ?", undef, $userid);
}

# Remember (User) - Get's if a user is using OpenID login.
sub using_openid {
    my $self = shift;
    my $userid = shift;
    my $userdb = $self->{dbi};
    return $userdb->selectrow_array("SELECT userid FROM openid_users WHERE userid = ?", undef, $userid)? "true" : "false";
}

sub clone_database {
    my $self = shift;
    $self->{dbi}{InactiveDestroy} = 1;
    $self->{dbi} = $self->{dbi}->clone
}

1;

__END__
CREATE TABLE dbinfo (
    schema_version int(10) not null UNIQUE
);

CREATE TABLE session (
    userid integer PRIMARY KEY autoincrement, 
    username varchar(32),
    sessionid char(32) not null UNIQUE
    uploadsid char(32) not null UNIQUE, 
);
CREATE INDEX index_session on session(username);

CREATE TABLE "users" (
    userid integer PRIMARY KEY autoincrement, 
    username varchar(32) not null UNIQUE, 
    pass varchar(32) not null, 
    last_login timestamp not null, 
    remember boolean not null, 
    created datetime not null, 
    email varchar(64) not null UNIQUE, 
    openid_only boolean not null, 
    confirmed boolean not null, 
    cnfrm_code varchar(32) not null
);

CREATE TABLE openid_users (
    openid_url varchar(128) not null PRIMARY key, 
    userid varchar(32) not null, 
    username varchar(32) not null
 );

CREATE TABLE "uploads" (
    trackid varchar(32) not null PRIMARY key, 
    userid integer not null UNIQUE, 
    public_users text, 
    sharing_policy varchar(36) not null, 
    users text, 
    path text, 
    description text, 
    data_source text, 
    modification_date datetime, 
    creation_date datetime not null, 
    public_count int, 
    title text, 
    imported boolean not null
);