Hi dude! I have an orrible trouble with this poor cgi: is a
client
pop3 web based gateway.The function "connetti()"
never been called and
i don't know why!!The functions in the bottom of the script
load,save,restore the state of the session by save the
user,pass,host,id in a file.if you try to execute the script
all stop
when you click on the submit button.I'm italian so i
apologize for the
bad english.
I hope there is a good soul who help me.
There is the code:
#!/usr/bin/perl -w
use Mail::POP3Client;
use CGI qw(:all);
#use CGIBook::Error;
#use HTML::Template;
local $MAX_FILES = 1000;
local $DATA_DIR = 'usr/lib/cgi-bin';
my $q = new CGI;
my $this_script_name = 'popGem.cgi';
my $id = get_id($q);
my $action = ( $q->param("action") ) ||
'start';
if ( $action eq "start") {
start($q,$id);
}
if ( $action eq "connetti" ) {
connetti($q,$id);
}
sub start {
my ($q ,$id) =  _;
print
$q-> header(),
$q-> start_html(-title => "PopGem pop3
web based reader"),
$q-> start_form(-action => $this_script_name
,-method =>
"post"),
$q-> table(
{-border => "1"},
$q->caption("PopGem pop3 web based
reader!"),
$q->Tr(
$q-> th("Nome
Utente:"),
$q-> th( textfield(-name =>
"user_name",-size
=> "30") )
),
$q-> Tr(
$q-> th("Password:"),
$q-> th( password_field(-name
=> "password",-
size => "30") )
),
$q-> Tr(
$q-> th("Nome
Server:"),
$q-> th( textfield(-name =>
"domain_name",-
size => "30") )
),
$q-> Tr(
$q-> th({-rowspan =>
"2"},
$q-> submit(-value =>
"connetti") )
),
$q->hidden(
-name => "id",
-default => $id,
-override => 1
),
$q->hidden(
-name => "action",
-default => "connetti",
-override => 1
)
),
$q-> end_form(),
$q-> end_html();
save_state($q);
}
sub connetti {
my ($q,$id) = _;
my $user_name = param('user_name');
my $password = param('password');
my $domain_name = param('domani_name');
#per ogni messaggio che è presente nella mailbox stampo una
riga di
una tabella
#con le informazioni utili: mittente,oggetto,ecc...
my $pop = new Mail::POP3Client ( USER =>
$user_name,
PASSWORD =>
$password,
HOST =>
$domain_name,
AUTH_MODE => 'PASS'
);
for ($i = 1; $i <= $pop->Count(); $i++) {
foreach my $message ( $pop->Head($i) ){
my $date = ($message =~ /^Date:s+/i);
my $from = ($message =~ /^From:s+/i);
my $to = ($message =~ /^To:s+/i);
my $subject = ($message =~ /^Subject:s+/i);
print $q-> header(),
$q-> start_html(-title => "Ecco i
messaggi"),
$q-> table(
{-border => "1"},
$q->caption("Informazioni del
messaggio $i:"),
$q->Tr(
$q-> th("Date:"),
$q-> th("From:"),
$q-> th("To:"),
$q-> th("Subject:")
),
$q->Tr(
$q-> th("$date"),
$q-> th("$from"),
$q-> th("$to"),
$q-> th("$subject")
)
),
$q-> end_html();
$q-> save_state($q);
}
}
}
sub get_id {
my $q = shift;
my $id;
my $unsafe_id = $q->param( "id" ) || '';
$unsafe_id =~ s/[^dA-Fa-f]//g;
if ( $unsafe_id =~ /^(.+)$/ ) {
$id = $1;
load_state( $q, $id );
}
else {
$id = unique_id( );
$q->param( -name => "id", -value
=> $id );
}
return $id;
}
# Loads the current CGI object's default parameters from the
saved
state
sub load_state {
my( $q, $id ) = _;
my $saved = get_state( $id ) or return;
foreach ( $saved->param ) {
$q->param( $_ => $saved->param($_) ) unless
defined $q-
>param($_);
}
}
# Reads a saved CGI object from disk and returns its params
as a hash
ref
sub get_state {
my $id = shift;
my $session = session_filename( $id );
local *FILE;
-e $session or return;
open FILE, $session or die "Cannot open $session:
$!";
my $q_saved = new CGI( *FILE ) or
error( $q, "Unable to restore saved
state." );
close FILE;
return $q_saved;
}
# Saves the current CGI object to disk
sub save_state {
my $q = shift;
my $session = session_filename( $id );
local( *FILE, *DIR );
# Avoid DoS attacks by limiting the number of data
files
my $num_files = 0;
opendir DIR, $DATA_DIR;
$num_files++ while readdir DIR;
closedir DIR;
# Compare the file count against the max
if ( $num_files > $MAX_FILES ) {
error( $q, "We cannot save your request because
the directory
" .
"is full. Please try again
later" );
}
# Save the current CGI object to disk
open FILE, ">> $session" or return die
"Cannot write to $session:
$!";
$q->save( *FILE );
close FILE;
}
# Separated from other code in case this changes in the
future
sub session_filename {
my $id = shift;
return "/$DATA_DIR/$id";
}
sub unique_id {
# Use Apache's mod_unique_id if available
return $ENV if exists $ENV;
require Digest::MD5;
my $md5 = new Digest::MD5;
my $remote = $ENV . $ENV;
# Note this is intended to be unique, and not
unguessable
# It should not be used for generating keys to sensitive
data
my $id = $md5->md5_base64( time, $$, $remote );
$id =~ tr|+/=|-_.|; # Make non-word chars URL-friendly
return $id;
}
--~--~---------~--~----~------------~-------~--~----~
You received this message because you are subscribed to the
Google Groups "Perl Programming" group.
To post to this group, send email to perl-programminggooglegroups.com
To unsubscribe from this group, send email to
perl-programming-unsubscribegooglegroups.com
For more options, visit this group at http:
//groups.google.com/group/perl-programming
-~----------~----~----~----~------~----~------~--~---
|