pwReset.pl

#!/usr/bin/perl -w

# pwreset.pl

# author: Peter Gietz

# Version 0.01
# 10.1.2011
# copyright DAASI international GmbH 2011

use warnings;

unshift (@INC,"../lib");
$ENV{PATH}= "/bin:/usr/bin/";
delete @ENV{ 'IFS', 'CDPATH', 'ENV', 'BASH_ENV' };
umask(077);


use vars qw($VERSION $NAME $PATH $PROT);

$VERSION = "0.1";
$NAME = 'pwReset';
$PATH =  '/cgi-bin';

$PROT = 'http';


use HTTP::Daemon;
use HTTP::Status;


use DAASIlib::CONF qw (is_debug);
use DAASIlib::LDAP;
use DAASIlib::LOG;
use DAASIlib::Convert;
use DAASIlib::Data;
use DAASIlib::SMTP;
#use DAASIlib::XML;
#use DAASIlib::Objects;
use DAASIlib::Gettext;

use Crypt::SmbHash qw(lmhash nthash);
use Digest::MD5 qw(md5 md5_hex md5_base64);
use Digest::SHA1  qw(sha1 sha1_hex sha1_base64);
use MIME::Base64;
use Encode qw(encode);
use Unicode::Map8;
use Unicode::String qw(utf16);
use Apache::Session::File;
require HTML::Template;
use URI::Escape;

use utf8;

use strict;
use vars qw( $count $config );
use CGI qw/:standard :html3/;
use CGI::Fast;

local $count =0;

my $conf = new DAASIlib::CONF;

#my $object = new DAASIlib::Objects;

our $data = new DAASIlib::Data;
our ($progname, $progpath, $etcdir, $sysconfig) = $data->getProgramFiles($0);
my $gt = $conf->loadConfig($sysconfig, $progpath, $etcdir, 0, $progname);
$data->init($progname, $conf->{data}{passwordfile});

my $is_verbose = $conf->{data}{verbose};

my $log = new DAASIlib::LOG;
$log->init($progname, $is_verbose);

#$conf->{data}{logfile} =~/^(.+)$/;
#my $logfile = $1;
my $logfile = $conf->{data}{logfile};
my $logger = $log->initLog4Perl($logfile, 
                                $conf->{data}{loglevel},
                                $conf->is_debug() );

$logger->info("$progname started");

if ( $conf->{data}{rewritepath} ) {
    $PATH = &rewritepath($PATH, $conf->{data}{rewritepath});
}



### may be that should become %inputfields ??
our %inputfields = ( 'mail' => { 
                         'name' => 'mail',
			 'type' => 'text',
			 'len' => 40,
			 'label' => 'Email address:',
			 'default' => '',
			 'regexp' => '.+\@.+\..+',
			 'ldapattr' => 'mail',
			 'status' => 'start', 
			 'priority' => 2, 
		     },
		     'login' => { 
                         'name' => 'login',
			 'type' => 'text',
			 'len' => 40,
			 'label' => 'Login name:',
			 'default' => '',
			 'regexp' => '',
			 'ldapattr' => 'uid',
			 'status' => 'start', 
			 'priority' => 1, 
		     },
		     'principalname' => {
                         'name' => 'principalname',
			 'type' => 'text',
			 'len' => 40,
			 'label' => 'TextGrid ID:',
			 'default' => '',
			 'regexp' => '.+\@.+',
			 'rule' => 'must contain an @ character',
			 'ldapattr' => 'edupersonprincipalname',
			 'status' => 'end;start', 
			 'priority' => 3,
			 'usage' => 'ID',
		     },	   
		     'password' => {
                         'name' => 'password',
			 'type' => 'password',
			 'len' => 40,
			 'label' => 'New password:',
			 'default' => '',
			 'regexp' => '.{8,}',
			 'rule' => 'must be at least 8 chars long',
			 'ldapattr' => 'userpassword',
			 'status' => 'printform', 
			 'priority' => 10, 
		     },
		     'retype' => {
                         'name' => 'retype',
			 'type' => 'password',
			 'len' => 40,
			 'label' => 'Please retype password:',
			 'default' => '',
#			 'regexp' => '.{8,}',
			 'ldapattr' => '',
			 'status' => 'printform',
			 'priority' => 11, 
		     },	   
   );

our $isdebug = 0;
our $istest = 0;

while ( my $cgi = new CGI::Fast ) {

    $count++;
    my $html = &buildResponse ( $cgi, $count );
    print $html;

}

sub buildResponse {
    my ( $q, $hitcount ) = @_;

    if ( $q->param('debug') ) {
	$isdebug=1;
    }

    if ( $conf->{'data'}{'emailconfig'} ) {
	foreach my $mailconf ( split /;/,  $conf->{'data'}{'emailconfig'} ) {
	    my ($key, $value ) = split (/=/, $mailconf, 2);
	    $key =~ s/^\\//;
	    $key =~ s/^#//;
	    $conf->{data}{emailinfo}{$key}=$value;
	    $logger->debug("found mail configuration: $key=$value");
	}
    }
#    else {
#	$response .= $q->("Sorry internal Error cannot perform, please send
#    }

    my $statusmessage = $q->param('status') ? $q->param('status') : 'none';

    $logger->info("pwreset ($VERSION) started, status: $statusmessage");
    $logger->debug("used sysfile $sysconfig");
    $logger->debug("used configfile $conf->{data}{configfile}");
#    $logger->debug("status is: ".$q->param('status')) if $q->param('status') ;

    my %session;
    my $sessionid = &handlesession($q, \%session, $statusmessage );

#    use Data::Dumper;
#    my $dumpstr = Dumper(%session);

    foreach my $key ( sort keys %session ) {
	if ( $key ) {
	    $logger->debug("session $key: ". $session{$key});
	}
    }

    my ($header, $response) = '';
    
    $header = &printheader($q);
    $response .= &debugcgi($q, $hitcount) if $isdebug;
#    $response .= $q->p("Session: $dumpstr") if $isdebug;

    $response .= $q->h1($conf->{'data'}{'title'});

    my $status = $q->param('status');

    if ( ! $status ) {
	$logger->debug("buildResponse(): No status thus stating start_process ...");
	$response .= &startprocess($q);
#	$response .= $q->h3("No Status, this shouldnd't happen here, please report");
    }
    elsif ( $status eq 'testcookie' ) {
	$response = &testcookie($q);
    }
    elsif ( $status eq 'sendlink' ) {
	$response .= &sendlink($q, \%session);
#	my ( $resp, $head ) = &sendlink($q);
#	$response .= $resp;
#	$header = $head if ($head );
    }
    elsif ( $status eq 'printform' ) {
	$response .= &printform($q, \%session);
    }
    elsif ( $status eq 'modify' ) {
	$response .= &modify($q, \%session);
    }
    elsif ( $conf->{data}{enableadminhelp} && $status eq 'adminhelp' ) {
#	my $lang = $q->param('lang') ? $q->param('lang') : 'en';
#	$response .= $q->pre(`./$NAME.pl -h -G $lang`);
	if ( my $feature = $q->param('helpfeature') ) {
	    $response .= $q->pre(`./$NAME.pl -H $feature`);
	}
	else {
	    $response .= $q->pre(`./$NAME.pl -h`);
	}
    }
    else {
	$response .= &printerror('status', $q);
    }


    if ( $conf->{data}{forcehttps} && ! $q->https ) {
	$response = $q->h3("ERROR Programm does not work without HTTPS");
    } 

    $response .= &printtail( $q);

    $logger->info("$progname ended");


    $response = "$header$response";

    return $response;

}

sub handlesession {
    my ( $q, $rh_session, $status ) = @_;

#    my %session;
#    my $exist = '';
    
    my $sid =  $q->cookie ( -name => $NAME );

    if ( $sid ) {

	my $sessionfile = $conf->{'data'}{ 'sessionpath' }."/$sid";
	if ( -e $sessionfile  ) {
#	    $exist = $sid;
	    $logger->debug( "Session-Management: Reading session $sid");
	    tie %{$rh_session}, "Apache::Session::File", $sid, 
	    { Directory => $conf->{'data'}{ 'sessionpath' }, 
	      LockDirectory => $conf->{'data'}{ 'sessionlockpath'} 
	    };
	}
	else {
	    $logger->debug( "Session-Management: creating new session $sid");

	    tie %{$rh_session}, "Apache::Session::File", undef, 
	    { Directory => $conf->{'data'}{ 'sessionpath' }, 
	      LockDirectory => $conf->{'data'}{ 'sessionlockpath'} 
	    };
	    $sid = $rh_session->{_session_id};
	    $rh_session->{'counter'}=0;
	    &setcookie( $q, $sid) ;
	}
    }
    else {
	tie %{$rh_session}, "Apache::Session::File", undef, 
	{ Directory => $conf->{'data'}{ 'sessionpath' }, 
	  LockDirectory => $conf->{'data'}{ 'sessionlockpath'} 
	};
	$sid = $rh_session->{_session_id};
	$rh_session->{'counter'}=0;
	&setcookie( $q, $sid) ;
    }

    if ( $rh_session->{'status'} ) {
	$rh_session->{'laststatus'} = $rh_session->{'status'};
    }
    $rh_session->{'status'} = $status;
    $rh_session->{'counter'} += 1;


    return $sid;
}
 


sub startprocess {
    my ( $q ) = @_;

    my $response = '';
    
    my $status = 'sendlink';

    my %params;
    $params{status}=$status;
    my $url = &createurl($q, \%params);

    $q->param('status', $status);

    $response .= $q->h2("Identify yourself");
    $response .= $q->p("my url: $url") if $isdebug;

    $response .= $q->start_form( -method => 'post',
				 -action => $url,
	);


    $response .= &printfields ($q, 'start', $conf->{'data'}{'oneinputfield'});
    $response .= &printhiddens($q, $status);

    $response .= $q->submit(-name =>'button_name',
			    -value =>'verify me',
	                   );

    $response .= $q->end_form;

    return $response;
}

sub createid {

    my $id = "xaOUd".rand(100000)."ff1A.846";
    

    return $id;
}

sub setcookie {
    my ( $q, $sid ) = @_;
    my $status = $q->param('status') ? $q->param('status'): 'none' ;
    $logger->debug("setcookie(): Status is: $status, SID is: $sid");

    my %params;
    if ( $status ne 'testcookie' && $status ne 'adminhelp' ) {
#    if ( $status ne 'testcookie' ) {
#	my $id = $sid;
	$params{'status'}='testcookie';
	my $nexturl = &createurl($q, \%params);
#       my $server = $q->server_name;
	#   my $id = &createid();
	my $cookietime = ($status eq 'modify') ? 'now' : &getcookietime();

	my $cookie = $q->cookie(-name => $NAME,
				-value   => $sid,
				-expires => $cookietime,
				-path    => $PATH,
#                             -domain  => 'XXX',
#                             -secure  => 1,
	    );
	
	$logger->debug(" setcookie(): sending |$cookie| via redirect to testcookie");
	print $q->redirect ( -url => $nexturl,
			     -cookie => $cookie );
	exit();
    }
}

sub createurl {
    my ( $q, $rh_params ) = @_;
    
    my $server = $q->server_name;
    my $url = $q->url();

    if ( $conf->{data}{rewritepath} ) {
	$url = &rewritepath($url, $conf->{data}{rewritepath});
    }

    my $token = '?';
    if ( $rh_params ) {
	foreach my $key ( keys %{$rh_params} ) {
	    $url .= $token;
	    $url .= $key.'='.$rh_params->{$key};
	    $token = '&';
	}
    }
    $url .= "${token}debug=".$q->param('debug') if $q->param('debug') ;

#    $status ? 
#	"$PROT://$server$PATH/$NAME.pl?status=$status" :
#	"$PROT://$server$PATH/$NAME.pl";
    
    $logger->debug("createurl(): created url $url");
    return $url;
}

sub testcookie {
    my ( $q ) = @_;
    my $response='';

    my $cookie = $q->cookie ( -name => $NAME );
    my $nexturl = &createurl( $q, undef);
    $logger->debug("testcookie(): Cookie is: $cookie");

    if ( defined $cookie ) {
#	$response .= $q->h2("TESTCOOKIE: SUCCESS");
	$logger->debug("testcookie(): Found cookie, will proceed");
	$q->param('status', 'sendlink');
	$response .= $q->h1($conf->{'data'}{'title'});
	$response .= &startprocess($q);
    }
    else {
	$logger->warn("testcookie(): Cookies seem to be disabled");

	$response .= $q->h2( "Cookies Disabled!" );
	$response .= $q->h3( "Your browser is not accepting cookies");
	$response  .= $q->p( "Please enable cookies in your browser preferences and ".
		   $q->a( { -href => $nexturl }, "return to start").
		   "."
	    );
    }
   
    return $response;
}

sub sendlink {
    my ( $q, $rh_session ) = @_;
    my ($header, $response) = '';

    $response .= $q->h2("Verification and sending email");

    if ( my $paramerrors = &getparamerrors ( $q ) ) {
#    if ( $paramerrors ) {
	$response .= $paramerrors;
	$response .= $q->p("Please try again");
	$response .=  &startprocess($q);
	return $response;
    }

    my $searchquery = &getsearchquery($q, 'start');
    $logger->debug("sendlinkl(): searchquery is $searchquery");

    my $filter = &createfilter( $q, $searchquery, 'start');
    my ( $searchresponse, $mail, $entry ) =  &searchentry($q, $rh_session, $filter);
    $response .= $q->b($searchresponse) if $searchresponse  ;
    my $user = " (".$q->param($searchquery).")";

    if ( ! $mail ) {					     
	$response .= &startprocess($q);
    }
    else {
	$response .=$q->p("Your TextGrid account $user exists.");
	$response .= $q->p("\nsmtpserver: ".$conf->{data}{emailinfo}{smtprelay}) if $isdebug;
	$response .= &sendlinkmail($q, $mail, $rh_session);
    }

    return $response;
}

sub getsearchquery {
    my ( $q, $status ) = @_;
    my $searchquery = '';

    if ( $q->param('search') ) {
	$searchquery = 'search';
    }
    else {
	foreach my $f ( sort prioritysort keys %inputfields ) {
	    if ( grep ( /$status/, split(/;/, $inputfields{$f}{status}) ) ) { 
		if ( $q->param($inputfields{$f}{name}) ) {
		    $searchquery = $inputfields{$f}{name};
		    last;
		}
	    }
	}
    }
    
    return $searchquery;
}


sub sendlinkmail {
    my ( $q, $mail, $rh_session ) = @_;
    my $response = '';

    my $status = 'printform';
    my $smtp = new DAASIlib::SMTP;

    
    $smtp->set_server($conf->{data}{emailinfo}{smtprelay});
    my $subject = $conf->{data}{emailinfo}{subjectpart};
    $subject .= " How to reset your TextGrid password"; 
    my $body = $conf->{data}{linkmail};
    my ($cc, $bcc, $pw) = '';
    $body =~ s/\$/\n/g;

    my $secret = &createid();

#    my $url = $q->url();
#    $url .= "?status=printform&sessionid=$secret";
#    $url .= "&debug=".$q->param('debug') if $q->param('debug') ;

    my %params;
    $params{status}=$status;
    $params{sessionid}=$secret;
    my $url = &createurl($q, \%params);

    $rh_session->{'secret'} = $secret;

    $body =~ s/%URL%/$url/;

    my $result = $smtp->send_mail($conf->{data}{emailinfo}{from},
		    $subject,$body,$mail,$cc,$bcc,
	            $conf->{data}{emailinfo}{hello},
	            $conf->{data}{emailinfo}{smtpuser},
	) if ! $istest;

    $response .= $q->p("An email has been sent to $mail.");

    

    return $response;

}


sub createfilter {
    my ( $q, $searchquery, $status ) = @_;

    my ( $searchattr, $filter ) = '';

    if ( $searchquery eq 'search' ) {
	$filter = '( | ';
	foreach my $f ( sort prioritysort keys %inputfields ) {
	    if ( grep ( /$status/, split(/;/, $inputfields{$f}{status}) ) ) { 
		$searchattr = $inputfields{$f}->{'ldapattr'};
		if ( $searchattr ) {
		    $filter .= "($searchattr=".$q->param($searchquery).")";
		}
	    }
	}
	$filter .= ')';
    }
    else {
	$searchattr = $inputfields{$searchquery}{'ldapattr'};
	$filter = "($searchattr=".$q->param($searchquery).")";
    }

    $logger->debug("createfilter(): created filter $filter");
    return $filter;
}

sub searchentry {
    my ( $q, $rh_session, $filter, $ldap ) = @_;
    my $response = '';

    my $searchattr;
#    my $filter;
    my $mail;
    my $entry;
    my $shouldclose = 0;

    my @attrs = &getattrs('start');


    $response .= $q->p("searching with Filter $filter") if $isdebug; 
    

    my $libldap = new DAASIlib::LDAP;
    my $rh_ldap = $libldap->defineServerFromURI($conf->{data}{ldapuri}, 
						'ldapuri', 0);
    $rh_ldap->{is_tls} = 1 if $conf->{data}{forcetls};

#    $rh_ldap->{scope}  = 'sub'; 

    $rh_ldap->{attribs}  = \@attrs; 
    $rh_ldap->{filter}  = $filter; 

    if ( ! $ldap ) {
#    my $ldap = $libldap->connectServer($rh_ldap, 1);
	$ldap = $libldap->connectServer($rh_ldap);
	if ( ! $ldap ) {
	    $response .= $q->p("could not connect to LDAP-Server");
	    return $response;
	}
	$shouldclose = 1;
    }

    my $mesg = $libldap->doSearch($ldap, $rh_ldap);
    if ($mesg->count()) {
	if ( $mesg->count() > 1 ) {
	    $response .= $q->p("Error: found more than one entry!!!");
	    $logger->error("Error: found more than one entry!!!");
	}

	$entry = $mesg->pop_entry();
	my $entrydn= $entry->dn();
	$logger->debug("found entry $entrydn");	
        $mail = $entry->get_value('mail');
	foreach my $attr ( @attrs ) {
	    $rh_session->{$attr} = $entry->get_value($attr);
	}
	if ( ! $mail ) {
	    $response .= $q->p("Error: could not find an email to send message to");
	    $logger->error("Error: could not find an email to send message to");
	}
    }
    else {
	$logger->debug("found no entry with filter $filter");	
	$response .= $q->p("Error: there is no user with $filter");
	$logger->error("Error: there is no user with $filter");
    }

    if ( $shouldclose ) {
	$ldap->unbind;
    }

    return $response, $mail, $entry;
}

sub printform {
    my ( $q, $rh_session ) = @_;

    $logger->debug("printform(): started");
    my $status = '';
    my $response = '';
    $response .= $q->h2("Input of new password");
    my $cookie = $q->cookie(-name => 'pwReset');

#   use Data::Dumper;
#    $response .= $q->p(Dumper($cookie));
    my $secret = $rh_session->{'secret'};

    if ( $q->param('sessionid') eq $secret ) {

	$response .= $q->h3("Everything went fine, you can now reset your Password");
	$status = 'modify';
	my %params;
	$params{'status'}=$status;
	my $url = &createurl($q, \%params);

	$response .= $q->start_form( -method => 'post',
				 -action => $url,
	    );
	$response .= &printfields ($q, 'printform');
	$logger->debug("printform(): status: $status");
	$response .= &printhiddens($q, $status);

	$logger->debug("printform(): fine so I set status to $status");
	$response .= $q->submit(-name =>'button_name',
				-value =>'reset password',
	    );
	$response .= $q->end_form;

    }
    else {
	my $cookietimestring  = &getcookietimestring();
	$response .= $q->h3("There has been an Error").
	    $q->p("This can be out of one of the following reasons:"). 
	    $q->ul( $q->li({-type=>'disc'},
			   [
			    "Your browser didn't allow to set a cookie",
			    "You used a different browser, when requesting the reset",
			    "The request is too old (older than $cookietimestring)",
			    "Any other unforseen error",
			   ]));
    }

    return $response;
}


sub modify {
    my ( $q, $rh_session ) = @_;
    
    my $response = '';
    my $cookie = $q->cookie(-name => 'pwReset');
    my $secret = $rh_session->{'secret'};
    my $user = $rh_session->{'edupersonprincipalname'};
    my $maxcount = 40;

    my $libldap = new DAASIlib::LDAP;
    my $rh_ldap = $libldap->defineServerFromURI($conf->{data}{ldapuri}, 
						'ldapuri', 0);
    $rh_ldap->{is_tls} = 1 if $conf->{data}{forcetls};
    my $ldap = $libldap->connectServer($rh_ldap);
#    my $maxcount = 4;

    $response .= $q->h2("Modifying Password");
    
    if ( $q->param('sessionid') eq $secret ) {
	if ( $q->param('password') eq $q->param('retype') ) {
	    if ( $rh_session->{'counter'} > $maxcount ) {
		$response .= $q->p("ERROR: Session is not valid any more, because it was called too often. You have to begin the process again");
		tied(%{$rh_session})->delete;
		my $url = &createurl($q, undef);
		$response .= $q->a( { -href => $url }, "return to start");
#		$response .= &startprocess($q);		
	    }
	    elsif (  my $paramerrors = &getparamerrors ( $q ) ) {
		$response .= $paramerrors;
		$response .= $q->p("Please try again");
		$response .= &printform($q, $rh_session);
	    }
	    else {
		my $idattr = $inputfields{&getidfield()}{'ldapattr'};
		my $user = $rh_session->{$idattr};
		my $filter = "($idattr=$user)";
		my ( $searchresponse, $mail, $entry ) =  &searchentry($q, $rh_session, $filter);
		my $entrydn = $entry->dn();
		$response .= $q->p("Password for user $user will be reset");
#		$response .= "entry: $entrydn";
		my $plain = $q->param('password');
		my $digest =  $conf->{'data'}{'pwhash'};
		my $encodedPassword = `/usr/sbin/slappasswd -h {$digest} -s \'$plain\'`;

		$logger->debug("changing Password of entry $entrydn at ". 
			       $conf->{data}{ldapuri});
		$entry->replace ( 
		    $inputfields{'password'}{'ldapattr'} => $encodedPassword
		    );
		my $res = $entry->update($ldap); 

## The following produces crypt passwords, that didn't work
#		use Net::LDAP::Extension::SetPassword;
#		my $res = $ldap->set_password(
#		    newpasswd => $q->param('password'),
#		    user      => $entrydn
#		    );
		$logger->debug("Result of password change: ".$res->error());
		$response .= $q->p("result of update: ".$res->error());
		$ldap->unbind;		
	    }
	}
	else {
	    $response .= $q->p("ERROR: the password and the retyped password did not match, please try again");
	    $response .= &printform($q, $rh_session);
	}
    }
    else {
	$response .= $q->p("ERROR: sessionid: $secret not returned in query: ".$q->param('sessionid') );
    }
    
    return $response;
}

sub getidfield {
    my $idfield='';
    foreach my $key ( keys %inputfields ) {
	if ( $inputfields{$key}{ 'usage'} eq 'ID') {
	    $idfield = $key;
	}
    }
    $idfield = $idfield ? $idfield : 'edupersonprincipalname';
    return $idfield;
}

sub getcookietime {
    my $string='';

    if ( $conf->{'data'}{'sessiontime'} =~/(\d+)([smhdMy])/ ) {
	$string = '+'.$conf->{'data'}{'sessiontime'};
    }
    else {
	$logger->error("ERROR: wrong Format in configuration of sessiontime");
    }

    return $string;
}	     


sub getcookietimestring {
    my $string='';

    my %units = (
	's' => 'seconds',
	'm' => 'minutes',
	'h' => 'hours',
	'd' => 'days',
	'M' => 'months',
	'y' => 'years',
	);

    my $num;
    my $unitstring;

    if ( $conf->{'data'}{'sessiontime'} =~/(\d+)([smhdMy])/ ) {
	$num = $1;
        $unitstring = $units{$2};
	$string = "$num $unitstring";
    }

    return $string;
}	     


sub rewritepath { 
    my ($path,$rules) = @_;
    
    foreach my $rule ( split / ?; ?/, $rules ) {
	my ($from, $to ) = split / ?=> ?/, $rule;
	$path =~s/$from/$to/;
    }
    return $path;
}

sub printhiddens {
    my ( $q, $state ) = @_;
    my $fields='';


    $logger->debug("printhiddens(): got status:        $state");
    $state = $state ? $state : $q->param('status');
    $logger->debug("printhiddens(): changed status to: $state");
###    $fields .= $q->hidden( 'status', "$state");
#### There seems to be a bug in the CGI-library, since the above didn't work ( 
    $fields .= "<input type=\"hidden\" name=\"status\" value=\"$state\"/>";

    $fields .= $q->hidden( 'sessionid', $q->param('sessionid') ) 
	if $q->param('sessionid') ;

#    $fields .= $q->hidden( -name => 'status', -default => "XXX${status}YYY");
#    $fields .= $q->hidden( -name => 'sxxxx', -default => "XXX${status}YYY");
#    $fields .= $q->hidden( -name => 'sessionid', -default => $q->param('sessionid') ) 
#	if $q->param('sessionid') ;

    if ( $q->param('debug') ) {
	$fields .= $q->hidden( -name => 'debug', -default => $q->param('debug'));
	$fields .= $q->p("debug is on");
    }
    $logger->debug("printhiddens(): returning fields: $fields");
    return $fields;
    
}

sub prioritysort {
    $inputfields{$a}->{'priority'}<=>$inputfields{$b}->{'priority'}
}

sub getattrs {
    my ($status) = @_;
    my @attrs=();
    $logger->debug("getattrs(): got status $status");

    foreach my $f ( sort prioritysort keys %inputfields ) {
	if ( grep ( /$status/, split(/;/, $inputfields{$f}{status}) ) ) { 
	    push @attrs, $inputfields{$f}{ldapattr};
	    $logger->debug("getattrs(): found attribute: ".$inputfields{$f}{ldapattr});
	}
    }
    return @attrs;
}

sub printfields {
    my ($q, $status, $isonefield) = @_;
    my $fields='';
    my $labels = 'Please input either ';
#Please input either your Login Name, your E-Mail address or your TextGrid ID. Your password can only be changed for @textgrid.de TextGrid IDs
    foreach my $f ( 
	sort { $inputfields{$a}->{'priority'}<=>$inputfields{$b}->{'priority'} }
	keys %inputfields ) {

	if ( grep ( /$status/, split(/;/, $inputfields{$f}{status}) ) ) { 
	    if  ( $inputfields{$f}{type} eq 'text' ) {
		my $label =  $inputfields{$f}->{'label'};
		$label =~ s/(.*):\s?/$1/;
		$labels .= "your $label or ";
		$fields .= &printtextfield($q,  $inputfields{$f});
	    }
	    elsif (  $inputfields{$f}->{type} eq 'password' ) {
		$fields .= &printpasswordfield($q, $inputfields{$f});
	    }
	    else {
		$fields .= &printerror('input type', $q); 
	    }
	    $fields .= $q->br;
	}
    }

    if ( $isonefield ) {
	$labels =~ s/ or $//;
        $labels .= "<br>\n (Your password can only be changed for \@textgrid.de TextGrid IDs)";
	$fields = $labels.": ".$q->br.$q->br;
	$fields .= $q->textfield(
	    -name => 'search',
	    -value => '',
	    -size =>40,
	    -maxlen => 40,
	);
    }
   
    return $fields;
}

sub printtextfield {
    my ($q,$f, $label) = @_;
    
    my $field = '';
    $label = $label ? $label : $f->{'label'};
    $field .= $label.$q->br;
    $field .= $q->textfield(
	-name => $f->{'name'},
	-value => $f->{'default'},
	-size => $f->{'len'},
	-maxlen => $f->{'len'},
	);

    return $field;
}

sub printpasswordfield {
    my ($q,$f) = @_;
    
    my $field = '';
    $field .= $f->{'label'}.$q->br;
    $field .= $q->password_field(
	-name => $f->{'name'},
	-value => $f->{'default'},
	-size => $f->{'len'},
	-maxlen => $f->{'len'},
	);

    return $field;
}



sub printtail {
    my ( $q) = @_;

    my $tail = $q->end_html();

    return $tail;
}


sub printheader {
    my ( $q ) = @_;

    my $header = $q->header(
	                -type   => 'text/html',
                        -charset=> $conf->{'data'}{'charset'},
        #               -pragma => 'no-cache', # for debugging only
        #               -expires=> 'now', # for debugging only
                        -expires=> '+3m', # should be used in production
#	                -cookie => $cookie,
                        );

#    if ( $cookie ) {
#	$logger->debug("Setting Cookie");
#    }

    my $color = $conf->{'data'}{'bgcolor'};

#    if ( $color !~ /#/ ) {
#	$color = '#'.$color;
#    }

    my %metas;

    foreach my $metadef ( split /\|/, $conf->{'data'}{'meta'} ) {
	my ($name,$content) = split /:/, $metadef, 2;
	$metas{$name}=$content;
    }
    $header .= $q->start_html(
	                -title => $conf->{'data'}{'title'},
	                -bgcolor => $color,
	                -meta => \%metas,
#	                -style => { -src => [ $conf->{'data'}{'cssfile'} ], 
#                                    -media => 'all'},
	);

 
    return $header;
}


sub printerror {
    my ( $err, $q) = @_;

    my $error = $q->p("Error: wrong $err");

    return $error;