Huge cgi!Help!

Discussion in 'Perl Misc' started by Zazen, Oct 7, 2007.

  1. Zazen

    Zazen Guest

    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{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;

    }
    Zazen, Oct 7, 2007
    #1
    1. Advertising

  2. Zazen wrote:
    > 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.


    <snip>
    > my $action = ( $q->param("action") ) || 'start';
    >
    > if ( $action eq "start") {
    >
    > start($q,$id);
    >
    > }
    >
    > if ( $action eq "connetti" ) {
    >
    > connetti($q,$id);
    >
    > }

    <snip>
    > $q->hidden(
    > -name => "action",
    > -default => "connetti",
    > -override => 1
    > )

    Without doing a detailed analysis, you have a field whose name conflicts
    with the attribute "action" on the form definition. This has bitten me
    in the past. Call your hidden field "action" something else, eg "zaction".

    my $action = ( $q->param("zaction") ) || 'start';

    .....
    $q->hidden(
    -name => "zaction",
    -default => "connetti",
    -override => 1
    )

    If you need more help with this I suggest you check out the posting
    guidelines before posting again - it will maximize your chances of
    getting assistance.

    Mark
    Mark Clements, Oct 7, 2007
    #2
    1. Advertising

  3. Zazen

    Zazen Guest

    I have try...but nothing.The error.log file of apache2 was the follow:

    [Sun Oct 07 11:59:23 2007] [error] [client 127.0.0.1] Use of
    uninitialized value in join or string at /usr/lib/perl/5.8/IO/Socket/
    INET.pm line 83., referer: http://localhost/cgi-bin/popGem.cgi
    [Sun Oct 07 11:59:23 2007] [error] [client 127.0.0.1] Use of
    uninitialized value in concatenation (.) or string at /usr/local/share/
    perl/5.8.8/Mail/POP3Client.pm line 387., referer: http://localhost/cgi-bin/popGem.cgi
    [Sun Oct 07 11:59:23 2007] [error] [client 127.0.0.1] Premature end of
    script headers: popGem.cgi, referer: http://localhost/cgi-bin/popGem.cgi

    I have to go crazy with this poor script...

    I don't know why the script don't run that function (the "connetti()"
    sub).This is the problem of that "Premature end of script headers".But
    about the other two line??
    Zazen, Oct 7, 2007
    #3
  4. On Sun, 07 Oct 2007 11:32:10 +0200, Mark Clements
    <> wrote:

    >> $q->hidden(
    >> -name => "action",
    >> -default => "connetti",
    >> -override => 1
    >> )

    >Without doing a detailed analysis, you have a field whose name conflicts
    >with the attribute "action" on the form definition. This has bitten me
    >in the past. Call your hidden field "action" something else, eg "zaction".


    Or, since he is Italian, "azione". It also will match better
    "connetti", which is actually already in Italian.


    Michele
    --
    {$_=pack'B8'x25,unpack'A8'x32,$a^=sub{pop^pop}->(map substr
    (($a||=join'',map--$|x$_,(unpack'w',unpack'u','G^<R<Y]*YB='
    ..'KYU;*EVH[.FHF2W+#"\Z*5TI/ER<Z`S(G.DZZ9OX0Z')=~/./g)x2,$_,
    256),7,249);s/[^\w,]/ /g;$ \=/^J/?$/:"\r";print,redo}#JAPH,
    Michele Dondi, Oct 7, 2007
    #4
  5. Zazen wrote:
    > I have try...but nothing.The error.log file of apache2 was the follow:
    >
    > [Sun Oct 07 11:59:23 2007] [error] [client 127.0.0.1] Use of
    > uninitialized value in join or string at /usr/lib/perl/5.8/IO/Socket/
    > INET.pm line 83., referer: http://localhost/cgi-bin/popGem.cgi
    > [Sun Oct 07 11:59:23 2007] [error] [client 127.0.0.1] Use of
    > uninitialized value in concatenation (.) or string at /usr/local/share/
    > perl/5.8.8/Mail/POP3Client.pm line 387., referer: http://localhost/cgi-bin/popGem.cgi
    > [Sun Oct 07 11:59:23 2007] [error] [client 127.0.0.1] Premature end of
    > script headers: popGem.cgi, referer: http://localhost/cgi-bin/popGem.cgi
    >
    > I have to go crazy with this poor script...
    >
    > I don't know why the script don't run that function (the "connetti()"
    > sub).This is the problem of that "Premature end of script headers".But
    > about the other two line??
    >

    You need to read the group posting guidelines.

    However, you can try the following:

    put "use strict;" at the top of your script and fix the resulting errors.

    run the script from the command-line

    put

    use CGI::Carp qw(fatalsToBrowser);

    at the top of your script. This may help you to better diagnose any
    problems.

    When I run the script, connetti *is* called, but the pop connection
    isn't succeeding and you aren't testing for that. From the perldoc:


    *State* The internal state of the connection: DEAD, AUTHORIZATION,
    TRANSACTION.

    so try checking $pop->State();

    Mark
    Mark Clements, Oct 7, 2007
    #5
  6. Zazen

    Zazen Guest

    Mark wrote:
    > You need to read the group posting guidelines.
    >
    > However, you can try the following:
    >
    > put "use strict;" at the top of your script and fix the resulting errors.
    >
    > run the script from the command-line
    >
    > put
    >
    > use CGI::Carp qw(fatalsToBrowser);
    >
    > at the top of your script. This may help you to better diagnose any
    > problems.
    >
    > When I run the script, connetti *is* called, but the pop connection
    > isn't succeeding and you aren't testing for that. From the perldoc:
    >
    > *State* The internal state of the connection: DEAD, AUTHORIZATION,
    > TRANSACTION.
    >
    > so try checking $pop->State();
    >
    > Mark



    Thanks Mark,i begin to find all the things that cause to fall the
    script,Thanks a lot!
    Zazen, Oct 7, 2007
    #6
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. Replies:
    15
    Views:
    741
    Arne Vajhøj
    Sep 9, 2009
  2. David S.

    huge help for interactive python

    David S., Feb 16, 2005, in forum: Python
    Replies:
    0
    Views:
    339
    David S.
    Feb 16, 2005
  3. Replies:
    18
    Views:
    719
    Joe Wright
    Nov 15, 2005
  4. Replies:
    3
    Views:
    490
  5. Professor Chen
    Replies:
    0
    Views:
    158
    Professor Chen
    Feb 6, 2006
Loading...

Share This Page