What is an Ignore list?
Huge cgi!Help!pop3 Client
Hello Guest
  
  • Login
• Register…
• Start blog
  • Who, Where, When
• What is interesting here?
• Duels
  • Polls
• Avatars
• Interests
  • Cities and Countries
• Random blog
• Users search
  • Search
• Games
• Tests
• QAIX
  • Ñîîáùåñòâà
• Talxy Chat
• Horoscope
• Online
 
Register!

QAIX > Perl web-programming > Huge cgi!Help!pop3 Client 7 October 2007 19:49:53

  Recent blog posts: 
  They have birthday today: 
  Forums:   
  Discuss: 
  Recent forum topics: 
  Recent forum comments:
  Ìîäåðàòîð:

Huge cgi!Help!pop3 Client

Zazen 7 October 2007 12:29:23
 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(-nam­e => "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,ec­c...

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("Inform­azioni 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;

}

Add comment
Gunnar Hjalmarsson 7 October 2007 19:49:53 permanent link ]
 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!! ...

Weren't the advices you got in comp.lang.perl.misc­ good enough?

--
Gunnar Hjalmarsson
Email: http://www.gunnar.c­c/cgi-bin/contact.pl­
Add comment
 

Add new comment

As:
Login:  Password:  
 
 
  
 
respect your talk pals, avoid using obscene language, typing entire messages in CAPS, posting buy/sell ads or violating netiquette or the RF Criminal Code..


QAIX > Perl web-programming > Huge cgi!Help!pop3 Client 7 October 2007 19:49:53

see also:
package org.openidex.jarpackager should…
3.3b1 - Properties Bug
j2eeServer api: how to create a new…
pass tests:
see also:
Greetings to all!
it's my brother and my band
Harvest your surprise on Thanksgiving…

  Copyright © 2001—2009 QAIX
Idea: Miñhael Monashev
See Help and FAQ in the community support.qaix.com.
Write in the community about the bugs you have noticedbugs.qaix.com.
Write your offers and comments in the communities suggest.qaix.com.
Information for parents.
Write us at:
If you would like to report an abuse of our service, such as a spam message, please .