[Roma.pm] huge script!Help!

Andrea Sesshin zazen85 at gmail.com
Sun Oct 7 03:35:22 PDT 2007


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 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{UNIQUE_ID} if exists $ENV{UNIQUE_ID};

    require Digest::MD5;

    my $md5 = new Digest::MD5;
    my $remote = $ENV{REMOTE_ADDR} . $ENV{REMOTE_PORT};
    # 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;
}
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://mail.pm.org/pipermail/roma/attachments/20071007/a151ba01/attachment-0001.html 


More information about the Roma mailing list