# ODP::Passport::Server - ODP::Passport server module (Version 0.01)
# Copyright (C)2002-2004 Richard P. Fuller <rpfuller@rpfuller.org>

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

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

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

package ODP::Passport::Server;

use strict;
use ODP::Passport; # For $ODP::Passport::ServerURL
use ODP::Passport::HTML;
use ODP::Passport::Server::HTML;
use ODP::Passport::Key;
use ODP::Editors::Editor;
use Digest::MD5 qw (md5_hex);
use CGI::Cookie;
use CGI qw(:standard);
use DBI;
use LWP::Simple();
use ODP::Stradivarius();
use HTTP::Request::Common qw(POST);



# new - Initialises a new ODP::Passport::Server object (connecting to the MySQL server)
# Parameters: MySQL DB username, MySQL DB password, MySQL additional options
# Returns: none
sub new ()
{
   my $object = {};
   my $dbh;

   eval
   {
      $dbh = DBI->connect("DBI:mysql:database=passport;host=localhost$_[3]",$_[1], $_[2],{'RaiseError' => 1});
   };

   if ($@)
   {
      print header(-type=>'text/html; charset=UTF-8');
      # Do not translate...
      print ODP::Passport::HTML::message("Error", "The system database is currently not running. Normal service will be resumed as soon as possible."); 
      exit;
   }

   $object->{'dbh'} = $dbh;

   $object->{'privs'} = '';
   $object->{'user'} = '';
   
   return bless $object;
}



# destroy - Destroys an ODP::Passport::Server object (disconnecting from the MySQL server)
# Parameters: none
# Returns: none
sub destroy ()
{
   my $self = shift;
   $self->{'privs'} = '';
   $self->{'dbh'}->disconnect();
}



# checklogin - Checks if the user is logged in validly, if so, continue, else display login prompt and exit
# Parameters: fromURL
# Returns: none
sub checklogin($)
{
   my $self = shift;
   
   my $fromURL = $_[0];
   
   my $user;
   my $md5;
   my $session;

   my %cookies = fetch CGI::Cookie;
   if ($cookies{'s_user'})
   {
      $user = $cookies{'s_user'}->value;
   }

   if ($cookies{'s_session'})
   {
      $session = $cookies{'s_session'}->value;
   }

   my $sth = $self->{'dbh'}->prepare("SELECT * FROM sessions WHERE name = ".$self->{'dbh'}->quote($user));

   $sth->execute;

   while (my $ref = $sth->fetchrow_hashref())
   {
      if ($ref && $user !~ / /) # To handle irritating mysql trailing space handling
      {
         if ($ref->{'id'} eq $session)
         {
            # User has a valid password cookie
         
            my $inner_sth = $self->{'dbh'}->prepare("SELECT * FROM users WHERE name = ".$self->{'dbh'}->quote($user));
            $inner_sth->execute();
            my $inner_ref = $inner_sth->fetchrow_hashref();
         
            $self->{'privs'} = $inner_ref->{'privs'}.' ';
            $self->{'user'} = $user;
            
            # Load the user's language...
            my $lang_sth = $self->{'dbh'}->prepare("SELECT * FROM usersettings WHERE editor = ".$self->{'dbh'}->quote($user));
            $lang_sth->execute;
 
            if ($lang_sth->rows > 0)
            {
               my $lang_ref = $lang_sth->fetchrow_hashref();
               $self->initialise_strings($lang_ref->{'language'});
            }
            else
            {
               $self->initialise_strings('eng');
            }
            
            $lang_sth->finish();
            
            return;
         }
      }
   }

   # User does not have a valid password cookie, display a login prompt and exit;
   if (CGI::param('lang'))
   {
      $self->initialise_strings(CGI::param('lang'));
   }
   else
   {
      $self->initialise_strings('eng');
   }

   my $username = '';
   if (CGI::param('user') =~ m!^[a-zA-Z]+$!)
   {
      $username = CGI::param('user');
   }   
   
   print header(-expires=>'-1d',-type=>'text/html; charset=UTF-8').ODP::Passport::Server::HTML -> loginbox($fromURL, $self->{'strings'}, $username);
   $sth->finish();
   $self->destroy();
   exit;
}



# isdisabled - Returns true if the user's passport has been inactivated
# Parameters: none
# Returns: 1 is inactive, undef/0 if not
sub isdisabled()
{
   my $self = shift;
   
   my $sth = $self->{'dbh'}->prepare("SELECT * FROM users WHERE name = ".$self->{'dbh'}->quote($self->{'user'}));

   $sth->execute;

   my $ref = $sth->fetchrow_hashref();
   my $return;
   
   if ($ref->{'disabled'})
   {
      $return = 1;
   }
   
   $sth->finish();
   
   if ($self->blocklist_isblocked($self->{'user'}))
   {
      $return = 1;
   }
   
   return $return;
}



# getsettings - Returns user settings hash
# Parameters: username
# Returns: <hash>
sub getsettings($user)
{
   my $self = shift;
   my $user = $_[0];
   
   my %settings = ();
   
   my $sth = $self->{'dbh'}->prepare("SELECT * FROM usersettings WHERE editor = ".$self->{'dbh'}->quote($user));
   
   $sth->execute;
   
   if ($sth->rows > 0)
   {
      my $ref = $sth->fetchrow_hashref();
      
      $settings{'cookietype'} = $ref->{'cookietype'};
      $settings{'css'} = $ref->{'css'};
      $settings{'autokeyclick'} = $ref->{'autokeyclick'};
      $settings{'language'} = $ref->{'language'};
   }
   
   else
   {
      $settings{'cookietype'} = 'session';
      $settings{'css'} = 'default';
      $settings{'autokeyclick'} = 0;
      $settings{'language'} = 'eng';
   }
   
   $sth->finish();
   
   return %settings;
}



# blocklist_editors - Returns an array of editors who have been blocked from the system
# Parameters: none
# Returns: array
sub blocklist_editors()
{
   my $self = shift;
   
   my $sth = $self->{'dbh'}->prepare("SELECT name FROM blocked");
   $sth->execute();

   my @editors = ();
   
   while (my $editor = $sth->fetchrow_hashref())
   {
      push @editors, $editor->{'name'};
   }

   $sth->finish;
   
   return sort @editors;
}



# blocklist_isblocked - Returns whether or not a specified editor is blocked
# Parameters: Editor name
# Returns: true (blocked)/false (not blocked)
sub blocklist_isblocked()
{
   my $self = shift;
   my $editor = $_[0];
   
   my $sth = $self->{'dbh'}->prepare("SELECT name FROM blocked WHERE name=".$self->{'dbh'}->quote($editor));
   $sth->execute;
   
   my $count = $sth->rows();
   
   $sth->finish;
   
   if ($count > 0){return 1;}else{return;}
}




# blocklist_add - Add an editor to the blocklist
# Parameters: Editor name
# Returns: none
sub blocklist_add($)
{
   my $self = shift;
   my $editor = $_[0];
   
   my $sth = $self->{'dbh'}->prepare("SELECT name FROM blocked WHERE name=".$self->{'dbh'}->quote($editor));
   $sth->execute();
   
   if ($sth->rows() > 0){return}
   $sth->finish;
   
   $self->{'dbh'}->do("INSERT INTO blocked VALUES(".$self->{'dbh'}->quote($editor).')');
}



# blocklist_delete - Delete an editor from the blocklist
# Parameters: Editor name
# Returns: none
sub blocklist_delete($)
{
   my $self = shift;
   my $editor = $_[0];
   
   $self->{'dbh'}->do("DELETE FROM blocked WHERE name=".$self->{'dbh'}->quote($editor));
}


# distribute_blocklist - Distributes the blocklist to all secrets that have requested it be enabled
# Parameters: none
# Returns: none
sub blocklist_distribute()
{
   my $self = shift;
   
   my $return = '';
   
   # First get a copy of the blocklist to send
   my @editors = $self->blocklist_editors();
   my $editor_string;
   
   foreach my $editor (@editors)
   {
      $editor_string .= "$editor,";
   }
   chop($editor_string);
   
   # Now find the relevant servers, and hit them
   my $sth = $self->{'dbh'}->prepare("SELECT * FROM secrets WHERE block_ext = 1");
   $sth->execute();
   
   while (my $ref = $sth->fetchrow_hashref())
   {
      # Generate a key... username: !SYSTEM
      my $time = time();
      my $key = new ODP::Passport::Key ("!SYSTEM", $ref->{'secret'}, $time, '');
      
      # Fetch...
      my $ua = new LWP::UserAgent;
      $ua->agent("ODP::");
      my $req = POST $ref->{'loginurl'}, [user=>'!SYSTEM',key=>$key->_key,privs=>'', issued=>$time, system_call=>'update_blocklist', block_list=>$editor_string]; # 
         
      my $res = $ua->request($req);
      
      my $content = $res->content;
      $content =~ s!&!&amp;!;
      $content =~ s!<!&lt;!;
      $content =~ s!>!&gt;!;
      $content =~ s!"!&quot;!;
      
      $return .= "<h3>$ref->{'name'}</h3>\n<xmp>". $content ."</xmp>\n";
   }
   
   $sth->finish;
   return $return;
}



# setsettings - Updates a user's settings
# Parameters: settings hash
# Returns: none
sub setsettings(%)
{
   my $self = shift;
   my %settings = @_;
   
   my $user = $self->currentuser();

   my $sth = $self->{'dbh'}->prepare("SELECT * FROM usersettings WHERE editor = ".$self->{'dbh'}->quote($user));

   $sth->execute;

   my $cookietype='';
   if ($settings{'cookietype'} eq '24h'){$cookietype='24h'}else{$cookietype='session'}
   
   my $css = $settings{'css'};
   $css=~s/[^a-z]//g;
   if (!$css){$css='default';}
   
   my $autokeyclick = '';
   if ($settings{'autokeyclick'}){$autokeyclick = 1}else{$autokeyclick=0}
   
   my $language = $settings{'language'};
   $language =~ s/[^A-Za-z0-9_]//g;
   if (!$language){$language='eng'}
      
   if ($sth->rows > 0)
   {
      $self->{'dbh'}->do("UPDATE usersettings SET cookietype=".$self->{'dbh'}->quote($cookietype).", css=".$self->{'dbh'}->quote($css).",autokeyclick=".$self->{'dbh'}->quote($autokeyclick).",language=".$self->{'dbh'}->quote($language)." WHERE editor=".$self->{'dbh'}->quote($user))
   }
   else
   {
      $self->{'dbh'}->do("INSERT INTO usersettings (editor,cookietype,css,language,autokeyclick) VALUES(".$self->{'dbh'}->quote($user).",".$self->{'dbh'}->quote($cookietype).",".$self->{'dbh'}->quote($css).",".$self->{'dbh'}->quote($language).",".$self->{'dbh'}->quote($autokeyclick).")");
   }
}



# login - Tries to login
# Parameters: username, password
# Returns: none
sub login($$)
{
   my $self = shift;
   
   my $user = $_[0];
   my $pass = $_[1];
   my $fromURL = param('fromURL');
   
   my $md5 = md5_hex($pass);
   
   my $sth = $self->{'dbh'}->prepare("SELECT * FROM users WHERE name = ".$self->{'dbh'}->quote($user));
   
   $sth->execute;
   
   my $ref = $sth->fetchrow_hashref();

   if ($ref && $user !~/ /) # To handle irritating mysql trailing space handling
   {
      if ($ref->{'password'} eq $md5)
      {
         # Login was valid
         
         # Fetch user settings (or defaults if applicable)
         my %settings = $self->getsettings($user);
         
         # Create a session
         my $buffer;
         open(SRC, "/dev/urandom");
         binmode SRC;
         read(SRC, $buffer, 16384);
         close SRC;
         
         my $session_id = md5_hex($buffer);
         
         my $session_destroy = time();
         
         if ($settings{'cookietype'} eq '24h')
         {
            $session_destroy += 24*3600 + 120;   
         }
         else
         {
            $session_destroy += 24*3600 + 120;
         }
         
         $self->{'dbh'}->do("INSERT INTO sessions VALUES (".$self->{'dbh'}->quote($session_id).",".$self->{'dbh'}->quote($user).",".$self->{'dbh'}->quote(CGI::remote_addr()).",".$session_destroy.")");
         
         my $cookie;
         my $cookie2;
         my $cookie3;
                  
         if ($settings{'cookietype'} eq '24h')
         {
            $cookie = new CGI::Cookie(-name=>'s_user', -value=>$user, -path=>'/', -expires=>'+1d');
            $cookie3 = new CGI::Cookie(-name=>'s_session', -value=>$session_id, -path=>'/', -expires=>'+1d'); # -expires=>'+1d'
         }
         else
         {
            $cookie = new CGI::Cookie(-name=>'s_user', -value=>$user, -path=>'/');
            $cookie3 = new CGI::Cookie(-name=>'s_session', -value=>$session_id, -path=>'/');
         }
         
         # Clean up old sessions
         $self->{'dbh'}->do("DELETE FROM sessions WHERE destroy < ".time());
         
         # Create cookies
         print header(-cookie=>[$cookie,$cookie3],-type=>'text/html; charset=UTF-8',-expires=>'-1d');

         # Did the user come from a script? If so, get them a key
         if (param('pp_cat') && param('pp_tool'))
         {
            my $pp_cat=param('pp_cat');
            my $pp_tool = param('pp_tool');
            
            my $params;
            foreach my $param (param())
            {
               if ($param =~ /^pp_p_/)
               {
                  $params.="&$param=".param($param);
               }
            }
   
            print <<END_HTML;
<head>
<meta http-equiv="refresh" content="0;URL=$ODP::Passport::ServerURL/logintotool.cgi?cat=$pp_cat&tool=$pp_tool$params">
</head>
<body></body>
END_HTML
         }
         # Else, let them continue on in
         else
         {
            # Really need to do better than this
            print <<END_HTML;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<head>
<meta http-equiv="refresh" content="0;URL=$ODP::Passport::ServerURL/">
</head>
<body></body>
</html>
END_HTML
            
         }

         $sth->finish();
         $self->destroy();
         exit;
      }
   }

   print header(-type=>'text/html; charset=UTF-8').ODP::Passport::Server::HTML::loginfailed($fromURL);
}



# logout - Logs out
# Parameters: none
# Returns: none
sub logout()
{
   my $self = shift;

   my %cookies = fetch CGI::Cookie;
   
   if ($cookies{'s_session'})
   {
      $self->{'dbh'}->do("DELETE FROM sessions WHERE name=".$self->{'dbh'}->quote($cookies{'s_user'}->value)." AND id=".$self->{'dbh'}->quote($cookies{'s_session'}->value));
   }
   
   my $cookie = new CGI::Cookie(-name=>'s_user', -value=>'', -path=>'/');
   my $cookie3 = new CGI::Cookie(-name=>'s_session', -value=>'', -path=>'/');
   
   print header(-cookie=>[$cookie,$cookie3], -type=>'text/html; charset=UTF-8');
   print ODP::Passport::HTML::message($self->{'strings'}{'strings.ppserver.logout_successful'}, $self->{'strings'}{'strings.ppserver.logout_successful_txt'}."<p><a href=\"/?lang=$self->{'strings'}->{'language'}\">ODP::Passport</a>");
}



# s_header - Returns the server CGI header
# Parameters: Title
# Returns: HTML
sub s_header($)
{
   my $self = shift;

   my $user='';
   
   my %cookies = fetch CGI::Cookie;
   if ($cookies{'s_user'})
   {
      $user = $cookies{'s_user'}->value;
   }
   
   my %settings = $self->getsettings($user);
   
   return ODP::Passport::Server::HTML::s_header_html($_[0], $settings{'css'});
}



# s_footer - Returns the server CGI footer
# Parameters: Title
# Returns: HTML
sub s_footer($)
{
   my $self = shift;
   
   my $user;
   
   my %cookies = fetch CGI::Cookie;
   if ($cookies{'s_user'})
   {
      $user = $cookies{'s_user'}->value;
   }
   
   my $sth=$self->{'dbh'}->prepare("SELECT * FROM secrets WHERE owner=".$self->{'dbh'}->quote($user));
   $sth->execute();
   my $developer = 0;
   if ($sth->rows() > 0){$developer=1;}
   $sth->finish();
   
   return ODP::Passport::Server::HTML::s_footer_html($user,$self->{'privs'},$developer,$self->{'strings'});
}



# tool_collections - Returns the 'tool collections' available (one secret per tool collection)
# Parameters: none
# Returns: hash of tool collections - key: name, value: owner
sub tool_collections
{
   my $self = shift;
   my $sth = $self->{'dbh'}->prepare("SELECT * FROM secrets");
   my %return=();
   $sth->execute;

   while (my $ref = $sth->fetchrow_hashref())
   {
      $return{$ref->{'name'}} = $ref->{'owner'};
   }

   return %return;
}



# tools - Returns the tools in a collection
# Parameters: collection
# Returns: hash of tools - key: name, value: fname\ndescription
sub tools
{
   my $self = shift;
   my $secret = $_[0];
   
   my %cookies = fetch CGI::Cookie;
 
   # Fetch user's privileges
   my $privs = $self->{'privs'};
   
   my $sth = $self->{'dbh'}->prepare("SELECT * FROM tools WHERE visible=1 AND secret = ".$self->{'dbh'}->quote($secret));

   my %return = ();
   $sth->execute;
   
   while (my $ref = $sth->fetchrow_hashref())
   {
      my $privsreq = $ref->{'privsreq'};
      
      if (!$privsreq
      || ($privsreq eq 'm' && ($privs =~ / meta / || $privs =~ / root / || $privs =~ / admin /))
      || ($privsreq eq 'k' && ($privs =~ / kmeta / || $privs =~ / root / || $privs =~ / admin /))
      || ($privsreq eq 'k|m' && ($privs =~ / k?meta / || $privs =~ / root / || $privs =~ / admin /))
      || ($privsreq eq 'j' && ($privs =~ / k?catmod:/ || $privs =~ / k?meta / || $privs =~ / root / || $privs =~ / admin /))
      || ($privsreq eq 'e' && ($privs =~ / k?editall/ || $privs =~ / k?catmod:/ || $privs =~ / k?meta / || $privs =~ / root / || $privs =~ / admin /))
      || ($privsreq eq 'ce' && ($privs =~ / k?editall/ || $privs =~ / k?catmod:/ || $privs =~ / k?meta / || $privs =~ / root / || $privs =~ / admin / || $privs =~ / k?cateditall:/))
      || ($privsreq eq 'a' && ($privs =~ / root / || $privs =~ / admin /))
      )
      {
         my $ext = '';
         my %descriptors=('m',$self->{'strings'}{'strings.ppserver.only_meta'},'k',$self->{'strings'}{'strings.ppserver.only_kmeta'},'k|m',$self->{'strings'}{'strings.ppserver.only_meta_or_kmeta'},'j',$self->{'strings'}{'strings.ppserver.only_jmeta'},'ce',$self->{'strings'}{'strings.ppserver.only_peditall'},'a',$self->{'strings'}{'strings.ppserver.only_admin'},'e',$self->{'strings'}{'strings.ppserver.only_editallplus'});
         if ($privsreq){$ext = "<div style=\"float:right; font-style:italic; font-emphasis: bold;\">($descriptors{$privsreq})</div>";}
         my $desc = $ref->{'description'};
         
         # Translate $desc...
         if ($desc =~ m!<desc>(.*)</desc>!s)
         {
             my $content = $1;
             my $text;
             my $string;
             
             if ($content =~ m!<text>(.*)</text>!s)
             {
                $text = $1;
                $desc = $text;
             }
             
             if ($content =~ m!<string>(.*)</string>!s)
             {
                $string = $1;
                $string =~ m!^(.*)\.([^\.]+)$!;
                my ($collection, $key) = ($1, $2);
                
                $self->{'strings'}->load("research.$collection");
                
                if ($self->{'strings'}{"strings.$collection.$key"})
                {
                   $desc = $self->{'strings'}{"strings.$collection.$key"};
                }
             }
         } 
 
         $return{$ref->{'name'}} = $ref->{'fname'}."\n".$desc.$ext;
         
         
      }
   }

   return %return;
}


# canaccess - Returns whether a user is allowed to access a tool or not
# Parameters: cat, tool
# Returns: boolean
sub canaccess($$)
{
   my $self = shift;
   my $cat = $_[0];
   my $tool = $_[1];
   
   my $privs = $self->{'privs'};
   
   my $sth = $self->{'dbh'}->prepare("SELECT * FROM tools WHERE secret = ".$self->{'dbh'}->quote($cat)." AND name = ".$self->{'dbh'}->quote($tool));

   $sth->execute;
   
   while (my $ref = $sth->fetchrow_hashref())
   {
      my $privsreq = $ref->{'privsreq'};
      if (!$privsreq
      || ($privsreq eq 'm' && ($privs =~ / meta / || $privs =~ / root / || $privs =~ / admin /))
      || ($privsreq eq 'k' && ($privs =~ / kmeta / || $privs =~ / root / || $privs =~ / admin /))
      || ($privsreq eq 'k|m' && ($privs =~ / k?meta / || $privs =~ / root / || $privs =~ / admin /))
      || ($privsreq eq 'j' && ($privs =~ / k?catmod:/ || $privs =~ / k?meta / || $privs =~ / root / || $privs =~ / admin /))
      || ($privsreq eq 'e' && ($privs =~ / k?editall/ || $privs =~ / k?catmod:/ || $privs =~ / k?meta / || $privs =~ / root / || $privs =~ / admin /))
      || ($privsreq eq 'ce' && ($privs =~ / k?editall/ || $privs =~ / k?catmod:/ || $privs =~ / k?meta / || $privs =~ / root / || $privs =~ / admin / || $privs =~ / k?cateditall:/))
      || ($privsreq eq 'a' && ($privs =~ / root / || $privs =~ / admin /))
      )
      {
         return 1;
      }
      else
      {
         return 0;
      }
   }
   
   return 1;
   
}


# genkey - Generates and returns a valid key for a set of tools
# Parameters: tool category
# Returns: a key
sub genkey($)
{
   my $self = shift;
   my $cat = $_[0];
   my $user;
   my $secret;

   # To generate a key we need the user's username, and the secret for the tool

   my %cookies = fetch CGI::Cookie;
   if ($cookies{'s_user'})
   {
      $user = $cookies{'s_user'}->value;
   }

   my $sth = $self->{'dbh'}->prepare("SELECT secret FROM secrets WHERE name = ".$self->{'dbh'}->quote($cat));

   $sth->execute;

   my $ref = $sth->fetchrow_hashref();
   if (!$ref)
   {
      # Error: exit
      print header(-type=>'text/html; charset=UTF-8').$self->message($self->{'strings'}{'strings.main.error'}, $self->{'strings'}{'strings.ppserver.invalid_category'});
      exit;
   }

   $secret = $ref->{'secret'};
   
   my $key;
   my $privs;
   my $privssth=$self->{'dbh'}->prepare("SELECT privs FROM users WHERE name=".$self->{'dbh'}->quote($user));
   $privssth->execute();
   my $privsref=$privssth->fetchrow_hashref();
   $privs = $privsref->{'privs'};
   $key = new ODP::Passport::Key ($user, $secret, time(),$privs);

   return $key;
}



# geturlforcat - Returns the login URL for a tool collection
# Parameters: category
# Returns: a URL
sub geturlforcat ($)
{
   my $self = shift;
   my $cat = $_[0];

   my $sth = $self->{'dbh'} -> prepare("SELECT loginurl FROM secrets WHERE name = ".$self->{'dbh'}->quote($cat));

   $sth->execute;

   my $ref = $sth->fetchrow_hashref();
   if (!$ref)
   {
      # Error: exit
      return;
   }

   return $ref->{'loginurl'};
}


# geturlfortool - Returns the URL of a tool
# Parameters: category, tool
# Returns: a URL
sub geturlfortool ($$)
{
   my $self = shift;
   my $cat = $_[0];
   my $tool=$_[1];

   my $sth = $self->{'dbh'} -> prepare("SELECT url FROM tools WHERE secret = ".$self->{'dbh'}->quote($cat)." AND name=".$self->{'dbh'}->quote($tool));

   $sth->execute;

   my $ref = $sth->fetchrow_hashref();
   if (!$ref)
   {
      # Error: exit
      return;
   }

   return $ref->{'url'};
}


# tooldetails - Returns the name and description of a tool
# Parameters: collection, tool
# Returns: tool friendly name, tool description
sub tooldetails($$)
{
   my $self = shift;
   my $cat = $_[0];
   my $tool = $_[1];
      
   #name,fname,description
   
   my $sth = $self->{'dbh'}->prepare("SELECT * FROM tools WHERE secret = ".$self->{'dbh'}->quote($cat)." AND name=".$self->{'dbh'}->quote($tool));

   $sth->execute;
   
   my $fname;
   my $desc;
   
   while (my $ref = $sth->fetchrow_hashref())
   {
      $fname=$ref->{'fname'};
      $desc=$ref->{'description'};
      
      # Translate $desc...
      if ($desc =~ m!<desc>(.*)</desc>!s)
      {
         my $content = $1;
         my $text;
         my $string;
            
         if ($content =~ m!<text>(.*)</text>!s)
         {
            $text = $1;
            $desc = $text;
         }
            
         if ($content =~ m!<string>(.*)</string>!s)
         {
            $string = $1;
            $string =~ m!^(.*)\.([^\.]+)$!;
            my ($collection, $key) = ($1, $2);
            
            $self->{'strings'}->load("research.$collection");
            
            if ($self->{'strings'}{"strings.$collection.$key"})
            {
               $desc = $self->{'strings'}{"strings.$collection.$key"};
            }
         }
      } 
   }

   return ($fname,$desc);
}



# currentuser - Returns the current user
# Parameters: none
# Returns: user
sub currentuser()
{
   my $user;
   my %cookies = fetch CGI::Cookie;
   if ($cookies{'s_user'})
   {
      $user = $cookies{'s_user'}->value;
   }
   return $user;
}


# chpass - Attempts to change a user's password
# Parameters: current, new, confirm
# Returns: none
sub chpass($$$)
{
   my $self = shift;
   my $current = $_[0];
   my $new = $_[1];
   my $confirm = $_[2];
   
   my $md5 = md5_hex($current);

   my $user = $self->currentuser();

   my $sth = $self->{'dbh'}->prepare("SELECT * FROM users WHERE name = ".$self->{'dbh'}->quote($user));

   $sth->execute;

   my $ref = $sth->fetchrow_hashref();

   if ($ref)
   {
      if ($ref->{'password'} ne $md5)
      {

         print $self->s_header($self->{'strings'}{'strings.main.failed'});
         print '<p>';
         print $self->message($self->{'strings'}{'strings.ppserver.incorrect_passphrase'},$self->{'strings'}{'strings.ppserver.incorrect_passphrase_txt'});
         exit;
      }
   }
   
   if ($confirm ne $new)
   {
      print $self->s_header($self->{'strings'}{'strings.main.failed'});
      print '<p>';
      print $self->message($self->{'strings'}{'strings.ppserver.passphrases_dont_match'}, $self->{'strings'}{'strings.ppserver.passphrases_dont_match_txt'});
      exit;
   }
   
   if (length ($new) > 255)
   {
      print $self->s_header($self->{'strings'}{'strings.main.failed'});
      print '<p>';
      print $self->message($self->{'strings'}{'strings.ppserver.too_long'},$self->{'strings'}{'strings.ppserver.too_long_txt'});
      exit;
   }

   if (length ($new) < 8)
   {
      # TODO: More checks to ensure sufficient password/passphrase complexity

      print $self->s_header($self->{'strings'}{'strings.main.failed'});
      print '<p>';
      print $self->message($self->{'strings'}{'strings.ppserver.insufficiently_complicated'},$self->{'strings'}{'strings.ppserver.insufficiently_complicated_txt'});
      exit;
   }
   
   # Some password checks by t23

   #Is the new passsword the same as the user's name (in any case)?
   if ($new =~ /^$user$/i)
   {
      print $self->s_header($self->{'strings'}{'strings.main.failed'});
      print '<p>';
      print $self->message($self->{'strings'}{'strings.ppserver.same_as_username'},$self->{'strings'}{'strings.ppserver.same_as_username_txt'});
      exit;
   }

   #Is the new password the same as the user's name with an additional character(s) appended (case #insensitive)?
   if ($new =~ /$user(\w|\d){1,2}/i)
   {
      print $self->s_header($self->{'strings'}{'strings.main.failed'});
      print '<p>';
      print $self->message($self->{'strings'}{'strings.ppserver.too_similar'}, $self->{'strings'}{'strings.ppserver.too_similar_txt'});
      exit;
   }

   #Is the new password the reverse of the username (case insensitive)?
   if (uc($new) eq uc(reverse($user)))
   {
      print $self->s_header($self->{'strings'}{'strings.main.failed'});
      print '<p>';
      print $self->message($self->{'strings'}{'strings.ppserver.too_similar'}, $self->{'strings'}{'strings.ppserver.too_similar_txt'});
      exit;
   }
   
   # /Some password checks by t23

   # Invalidate all sessions for the user - this is not particularly friendly, but required security-wise
   $self->{'dbh'}->do("DELETE FROM sessions WHERE name=".$self->{'dbh'}->quote($user));
   
   # Change password
   $self->{'dbh'}->do("UPDATE users SET password = ".$self->{'dbh'}->quote(md5_hex($new))." WHERE name = ".$self->{'dbh'}->quote($user));

   print $self->s_header($self->{'strings'}{'strings.ppserver.passphrase_changed'});
   print '<p>';
   print $self->message($self->{'strings'}{'strings.ppserver.passphrase_changed'}, $self->{'strings'}{'strings.ppserver.passphrase_changed_txt'}.'<p><a href="'.$ODP::Passport::ServerURL.'/">ODP::Passport</a>');
   print '</td></tr></table></body></html>';
}

# resetpass - Resets a user's password
# Parameters: Your ODP username, your ODP password, username to reset passphrase of
# Returns: none
sub resetpass()
{
   my $self = shift;
   
   my $u_name = $_[0];
   my $u_pass = $_[1];
   my $user = $_[2];
   my $lang = $_[3];

   $lang =~ s![^a-z]+!!g;
   $self->initialise_strings($lang);
   
   my $sth = $self->{'dbh'}->prepare("SELECT * FROM users WHERE name = ".$self->{'dbh'}->quote($user));
   $sth->execute;
   if ($sth->fetchrow_hashref())
   {
      my $passphrase = '';
      for (my $n=0; $n<16; $n++)
      {
         $passphrase .= chr(rand(25) + 65);
      }
      
      # TODO: Reset e-mail should be sent in the user's Passport language, English, and the language they chose on the public interface
      
      my $subject = 'ODP::Passport Account';
      my $english = new ODP::Stradivarius;
      $english->setlang('eng');
      $english->load('locale');
      $english->load('ppserver');
      $self->{'strings'}->load('locale');
      
      if ($lang ne 'eng' && $english->{'strings.ppserver.passport_account'} ne $self->{'strings'}.{'strings.ppserver.passport_account'})
      {
         $subject = $self->{'strings'}->{'strings.ppserver.passport_account'}." (ODP::Passport Account)";
      }
      
      my $ip = remote_host();
      my $message;
      
      if ($lang ne 'eng')
      {
         $message .= <<END;
$self->{'strings'}->{'strings.ppserver.email_reset_1'} $ip

$self->{'strings'}->{'strings.ppserver.new_passphrase'}: $passphrase

$self->{'strings'}->{'strings.ppserver.email_reset_2'}

$self->{'strings'}->{'strings.ppserver.email_auto'}

--

This e-mail is a translation into $english->{"strings.locale.locale_$lang"}. The original English e-mail is included below.

--
   
END
      }
      
      $message .= <<END;
You, or someone pretending to be you, has requested a passphrase reset on your ODP::Passport account, from $ip.
 
New Passphrase: $passphrase
 
If you did not apply for this reset, please return this message.
 
(This message is automatically generated.)
END
 
      $self->{'dbh'}->do("UPDATE users SET password=".$self->{'dbh'}->quote(md5_hex($passphrase))." WHERE name=".$self->{'dbh'}->quote($user));
 
      my $editor = new ODP::Editors::Editor ($u_name, $u_pass, $user);
      $editor->sendfeedback($subject, $message);
      
      print header(-type=>'text/html; charset=UTF-8').$self->message($self->{'strings'}{'strings.ppserver.passphrase_sent'},$self->{'strings'}{'strings.ppserver.passphrase_sent_txt'}.'<p><a href="/">ODP::Passport</a>');
   }
   else
   {
      print header(-type=>'text/html; charset=UTF-8').$self->message($self->{'strings'}{'strings.main.failed'},$self->{'strings'}{'strings.ppserver.failed_send_passphrase'}.'<p><a href="/">ODP::Passport</a>');
   }
}


# userexists - Checks if a user exists
# Parameters: editor name
# Returns: true (exists)/false (doesn't exist)
sub userexists($)
{
   my $self = shift;
   my $name = $_[0];
   
   my $return;
   my $sth = $self->{'dbh'}->prepare("SELECT * FROM users WHERE name=".$self->{'dbh'}->quote($name));
   $sth->execute();
   
   if ($sth->rows > 0)
   {
      $return = 1;
   }
   
   $sth->finish();
   
   return $return;
}


# adduser - Adds a new user, and mails them
# Parameters: your ODP editorname, your ODP password, username, language
# Returns: none
sub adduser($$$$)
{
   my $self = shift;
   my $u_name = $_[0];
   my $u_pass = $_[1];

   my $user = $_[2];
   my $lang = $_[3];

   $lang =~ s![^a-z]+!!g;
   $lang = $lang ? $lang : 'eng';
   
   $self->initialise_strings($lang);
   
   my $sth = $self->{'dbh'}->prepare("SELECT * FROM users WHERE name = ".$self->{'dbh'}->quote($user));
   $sth->execute;
   if ($sth->fetchrow_hashref())
   {
      print header(-type=>'text/html; charset=UTF-8').$self->message($self->{'strings'}{'strings.ppserver.already_signed_up'},$self->{'strings'}{'strings.ppserver.already_signed_up_txt'}.'<p>'.$self->{'strings'}->strings('strings.ppserver.already_signed_up_txt_2',"<a href=\"$ODP::Passport::ServerURL/resetpass.cgi?lang=$lang\">$ODP::Passport::ServerURL/resetpass.cgi</a>").'.');
      exit;
   }
   
   print header(-type=>'text/html; charset=UTF-8');
   my $passphrase = '';
   for (my $n=0; $n<16; $n++)
   {
      $passphrase .= chr(rand(25) + 65);
   }

   my $subject = 'ODP::Passport Account';
   my $english = new ODP::Stradivarius;
   $english->setlang('eng');
   $english->load('locale');
   $english->load('ppserver');
   $self->{'strings'}->load('locale');
      
   if ($lang ne 'eng' && $english->{'strings.ppserver.passport_account'} ne $self->{'strings'}.{'strings.ppserver.passport_account'})
   {
      $subject = $self->{'strings'}->{'strings.ppserver.passport_account'}." (ODP::Passport Account)";
   }
   
   my $ip = remote_host();
   
   my $message;
   
   if ($lang ne 'eng')
   {
      my $translation_info; 
      if ($english->{'strings.ppserver.email_signup_translation'} ne $self->{'strings'}.{'strings.ppserver.email_signup_translation'})
      {
         $translation_info = $self->{'strings'}->strings('strings.ppserver.email_signup_translation',$self->{'strings'}->{"strings.locale.locale_$lang"})."\n\n";
      }
   
      $message .= <<END;
$self->{'strings'}->{'strings.ppserver.email_signup_1'} $ip

$self->{'strings'}->{'strings.ppserver.email_signup_2'} $ODP::Passport::ServerURL/

$self->{'strings'}->{'strings.main.username'}: $user
$self->{'strings'}->{'strings.ppserver.passphrase'}: $passphrase

$self->{'strings'}->{'strings.ppserver.email_signup_3'}

$self->{'strings'}->{'strings.ppserver.email_auto'}

--

${translation_info}This e-mail is a translation into $english->{"strings.locale.locale_$lang"}, the language selected at signup time. The original English e-mail is included below.

--
   
END
   }
   
   # This, and the previous line, are supposed to be in English, and should not be translated
   $message .= <<END;
You, or someone pretending to be you, has signed up for an ODP::Passport account, from: $ip

You can log in to your account at: $ODP::Passport::ServerURL/

Username: $user
Passphrase: $passphrase

If you did not apply for this account, and you do not want it, please reply to this message asking for the account to be deleted.

(This message is automatically generated.)
END

   

   $self->{'dbh'}->do("INSERT INTO users VALUES (".$self->{'dbh'}->quote($user).", ".$self->{'dbh'}->quote(md5_hex($passphrase)).", ".time.",0,'')");

   $self->checkeditallprivs($user);
   
   my $editor = new ODP::Editors::Editor ($u_name, $u_pass, $user);
   $editor->sendfeedback($subject, $message);
   
   # Set the user's default language
   $self->{'dbh'}->do("INSERT INTO usersettings VALUES(".$self->{'dbh'}->quote($user).",'session','default',".$self->{'dbh'}->quote($lang).",0)");
   
   print $self->message($self->{'strings'}->{'strings.ppserver.signup_successful'},$self->{'strings'}->{'strings.ppserver.signup_successful_txt'}."<p><a href=\"/?lang=$lang\">ODP::Passport</a>");
}



# checkstilleditor - Checks whether the user is still an editor, and acts accordingly
# Parameters: your ODP editorname, your ODP password, disagree (boolean, check for reactivation)
# Returns: none
sub checkstilleditor($$)
{
   my $self = shift;
   my $u_name = $_[0];
   my $u_pass = $_[1];
   my $disagree = $_[2];
   my $force80 = $_[3];
   
   my $user = $self->currentuser();

  
   my $sth = $self->{'dbh'}->prepare("SELECT * FROM users WHERE name = ".$self->{'dbh'}->quote($user));
   $sth->execute;

   my $ref = $sth->fetchrow_hashref();

   if (!$ref)
   {
      # This shouldn't happen, but hey, you never know
      print header(-type=>'text/html; charset=UTF-8').$self->message($self->{'strings'}{'strings.ppserver.fatal_error'}, $self->{'strings'}{'strings.ppserver.fatal_error_txt'});
      exit;
   }
   
   my $lastcheck = $ref->{'lastcheck'};
   my $disabled = $ref->{'disabled'};

   if (!$disabled || $disagree)
   {
      if ((time() > ($lastcheck+86400)) || $disagree)
      {
         # Check if they're an editor
         # Requires access to editorinfo
         my $editor = new ODP::Editors::HTTP('GET',"http://editors.dmoz.org/editors/editorinfo.cgi?ed=$user&getinfo=1&getexists=1",$u_name,$u_pass);
         my $content = $editor->execute();

         if ($content !~ /^exists:1/)
         {
            # Time to inactivate
            $disabled = 1;
            $self->{'dbh'}->do("UPDATE users SET DISABLED=1 WHERE name = ".$self->{'dbh'}->quote($user));
         }
         else
         {
            if ($disagree)
            {
               $disabled = 0;
               $self->{'dbh'}->do("UPDATE users SET DISABLED=0 WHERE name = ".$self->{'dbh'}->quote($user));
            }
            
            # Determine editall/etc. privs
            $self->checkeditallprivs($self->currentuser(), $content);
         }

         $self->{'dbh'}->do("UPDATE users SET lastcheck=".time()." WHERE name = ".$self->{'dbh'}->quote($user));
      }
   }
   
   if ($self->blocklist_isblocked($user))
   {
      $disabled = 1;
   }

   if ($disabled)
   {
      print header(-type=>'text/html; charset=UTF-8').$self->message($self->{'strings'}{'strings.ppserver.odp_inactive'},$self->{'strings'}{'strings.ppserver.odp_inactive_txt_1a'}.'<p><a href="disagree.cgi">'.$self->{'strings'}{'strings.ppserver.disagree'}.'</a> '.$self->{'strings'}{'strings.ppserver.odp_inactive_txt_2'});
      exit;
   }
   
   if (!$disabled && $disagree)
   {
      print header(-type=>'text/html; charset=UTF-8').$self->message($self->{'strings'}{'strings.ppserver.passport_reactivated'},$self->{'strings'}{'strings.ppserver.passport_reactivated_txt'}.'<p><a href="/">ODP::Passport</a>');
      exit;
   }
}



# checkprivs - Checks the user's privileges and alters as necessary (for those that just can't wait 24 hours)
# Parameters: your ODP editorname, your ODP password
# Returns: none
sub checkprivs($$)
{
   my $self = shift;
   my $u_name = $_[0];
   my $u_pass = $_[1];
   my $newprivs;
   
   my $user = $self->currentuser();

   my $sth = $self->{'dbh'}->prepare("SELECT * FROM users WHERE name = ".$self->{'dbh'}->quote($user));
   $sth->execute;

   my $ref = $sth->fetchrow_hashref();

   if (!$ref)
   {
      # This shouldn't happen, but hey, you never know
      print header(-type=>'text/html; charset=UTF-8').$self->message($self->{'strings'}{'strings.ppserver.fatal_error'}, $self->{'strings'}{'strings.ppserver.fatal_error_txt'});
      exit;
   }
   
   my $disabled = $ref->{'disabled'};

   if (!$disabled)
   {
         my $editor = new ODP::Editors::HTTP('GET',"http://editors.dmoz.org/editors/editorinfo.cgi?ed=$user&getinfo=1&getexists=1",$u_name,$u_pass);
         my $content = $editor->execute();

         if ($content !~ /^exists:1/)
         {
            # Time to inactivate
            $disabled = 1;
            $self->{'dbh'}->do("UPDATE users SET DISABLED=1 WHERE name = ".$self->{'dbh'}->quote($user));
         }
         else
         {
            # Determine editall/etc. privs
            $newprivs = $self->checkeditallprivs($self->currentuser(), $content);
         }
   }

   if ($disabled)
   {
      print header(-type=>'text/html; charset=UTF-8').$self->message($self->{'strings'}{'strings.ppserver.odp_inactive'},$self->{'strings'}{'strings.ppserver.odp_inactive_txt_1b'});
      exit;
   }
   
   if (!$disabled)
   {
      my $old = $ref->{'privs'};
      my $new = $newprivs;
      $old =~ s!^ +!!; $old =~ s! +$!!;
      $new =~ s!^ +!!; $new =~ s! +$!!;

      if ($old eq $new)
      {
         print header(-type=>'text/html; charset=UTF-8').$self->message($self->{'strings'}{'strings.ppserver.no_priv_change'},$self->{'strings'}{'strings.ppserver.no_priv_change_txt'}."<br><pre>$new</pre><p><a href=\"/\">ODP::Passport</a>");
      }
      else
      {
         print header(-type=>'text/html; charset=UTF-8').$self->message($self->{'strings'}{'strings.ppserver.priv_change'},$self->{'strings'}{'strings.ppserver.priv_change_txt'}."<br><pre>$new</pre><p><a href=\"/\">ODP::Passport</a>");
      }
      exit;
   }
}



# New version, using editorinfo.cgi
sub checkeditallprivs($$)
{
   my $self = shift;
   my $editor=$_[0];
   my $content=$_[1]; # For efficiency's sake we pass the already downloaded content from above
      
   my ($root,$admin,$editall,$catmv,$meta,$keditall,$kcatmv,$kmeta)=();
   my (@editall, @keditall)=();
   foreach my $line (split(/\n/,$content))
   {
      if ($line =~ /^root:1/)
      {
         $root='root';
      }
      elsif ($line =~ /^admin:1/)
      {
         $admin='admin'; 
      }
      elsif ($line =~ /^editall:1/)
      {
         $editall='editall';
      }
      elsif ($line =~ /^keditall:1/)
      {
         $keditall='keditall';
      }
      elsif ($line =~ /^catmv:1/)
      {
         $catmv='catmv';
      }
      elsif ($line =~ /^kcatmv:1/)
      {
         $kcatmv = 'kcatmv';
      }
      elsif ($line =~ /^meta:1/)
      {
         $meta = 'meta';
      }
      elsif ($line =~ /^kmeta:1/)
      {
         $kmeta = 'kmeta';
      }
      elsif ($line =~ /^C:(Kids_and_Teens\/.*)$/) # MUST come before none K&T line
      {
         push @keditall, $1;
      }
      elsif ($line =~ /^C:(.*)$/)
      {
         push @editall, $1;
      }
   }
   
   my ($status,$kstatus)=();
   
   if ($root eq 'root')
   {
      $status = 'root';
   }
   elsif ($admin eq 'admin')
   {
      $status = 'admin meta'; #TODO: Remove meta from this once people update their client-side libraries
   }
   elsif ($editall eq 'editall' && $meta eq 'meta')
   {
      $status = 'meta';
   }
   elsif (@editall && $meta eq 'meta')
   {
      foreach my $item (@editall)
      {
         $status .= 'catmod:'.$item.' ';
      }
   }
   elsif ($editall eq 'editall' && $catmv eq 'catmv')
   {
      $status = 'editall/catmv';
   }
   elsif ($editall eq 'editall')
   {
      $status = 'editall';
   }
   elsif (@editall && $catmv eq 'catmv')
   {
      foreach my $item (@editall)
      {
         if ($item)
         {
            $status .= 'cateditall:'.$item.' ';
         }
      }
   }
   else
   {
      $status = '';
   }

   if ($root eq 'root')
   {
      #$kstatus = 'kroot'; # Let's not do this anymore
   }
   elsif ($admin eq 'admin')
   {
      #$kstatus = 'kadmin'; # Let's not do this anymore
   }
   elsif ($keditall eq 'keditall' && $kmeta eq 'kmeta')
   {
      $kstatus = 'kmeta';
   }
   elsif (@keditall && $kmeta eq 'kmeta')
   {
      foreach my $item (@keditall)
      {
         if ($item)
         {
            $kstatus .= 'kcatmod:'.$item.' ';
         }
      }
   }
   elsif ($keditall eq 'keditall' && $kcatmv eq 'kcatmv')
   {
      $kstatus = 'keditall/kcatmv';
   }
   elsif ($keditall eq 'keditall')
   {
      $kstatus = 'keditall';
   }
   elsif (@keditall && $kcatmv eq 'kcatmv')
   {
      foreach my $item (@keditall)
      {
         $kstatus .= 'kcateditall:'.$item.' ';
      }
   }
   else
   {
      $kstatus = '';
   }
   
   my $tstatus = " $status $kstatus ";
   $tstatus =~ s/ $//g;
   
   $self->{'dbh'}->do("UPDATE users SET privs=".$self->{'dbh'}->quote($tstatus)." WHERE name = ".$self->{'dbh'}->quote($editor));
   
   return $tstatus; # If we don't use it it doesn't matter, but we might want it for something
}



# message (server version) -- this version uses CSS
# Parameters: title, body
# Returns: HTML message box
sub message ($$)
{
   my $self = shift;
   my $title = $_[0];
   my $body = $_[1];

   my $user = '';
   
   my %cookies = fetch CGI::Cookie;
   if ($cookies{'s_user'})
   {
      $user = $cookies{'s_user'}->value;
   }
   
   my %settings = $self->getsettings($user);
   
   return ODP::Passport::Server::HTML::message($title, $body, $settings{'css'});
}



# initialise_strings - Initialise a set of language strings, given a language code
# Parameters: language code
# Returns: none
sub initialise_strings($)
{
   my $self = shift;
   my $language = shift;
   
   $language =~ s![^a-z]!!g;
   
   $self->{'strings'} = new ODP::Stradivarius;
   $self->{'strings'}->setlang($language);
   $self->{'strings'}->load("main");
   $self->{'strings'}->load("timedate");
   $self->{'strings'}->load("ppserver");
}





1;