Perl ftp question, like the previous ones - perl

I need to move or copy a simple text file from one web site to another web site.
I have administrator rights to both web sites. The first web site has a large data file (again, just a text file), certain records are selected and written to a team file (for entry into a tournament). Next I go through paypal and pay for the entries. The second site is for the the club running the tournament and I use IPN to return to a script on their site and if it verified, I add the team memebers into the master file for the tournament. I am limited to the ONE IPN script on the tournament site because I have a ton of other entries that come in from all over. The first site has the rosters for the state and no need to type all that data from each club, use the rosters like I use for all the non-paypal tounamenmts.
I can ftp the team file to the second server and place it in the folder just like it was created from scratch from that server originally and everything should go fine but I took the examples and tried them and nothing.
Here's the code section:
my $custom = $in->param('custom');
my $filename = "$ENV{DOCUMENT_ROOT}/database/$custom";
my $usjochost = '208.109.14.105';
my $okserieshost = '208.109.181.196';
my $usjocuser = 'teamentry';
my $okseriesuser = 'okwaentry';
my $usjocpw = 'Password1';
my $okseriespw = 'Password1';
my $file = $custom;
my $usjocpath ='/home/content/u/s/j/usjoc/html/database/';
my $okseriespath ='/home/content/o/k/s/okseries/html/database/';
$ftp = Net::FTP->new($okserieshost, Debug => 0) or die "Could not connect to '$okserieshost': $#";
$ftp->login($okseriesuser, $okseriespw) or die sprintf "Could not login: %s", $ftp->message;
#$ftp->cwd(/database) or die sprintf "Could not login: %s", $ftp->message;
$ftp->get($filename);
#$ftp = Net::FTP->new($usjochost, Debug => 0) or die "Could not connect to '$usjochost': $#";
$ftp->quit;
I NEED to READ the file on the first web site (okseries.com) and write the file on the second web site (usjoc.com). I have no problem reading and writing the file on the server, is sending the file to the second server. HELP! I'm not a genius at PERL.

i tested the code you made and implemented to it, the follow code will connect to your first host, okserieshost and get the $filename from database folder, verify if the file was downloaded (if not it will end operations).
#!/usr/bin/perl
use Net::FTP;
my $path = '/public_html/api';
my $filename = 'index.php';
my $host = '';
my $user = '';
my $pass = '';
print "Content-type: text/html\n\n";
$ftp = Net::FTP->new($host, Debug => 0) or die "Could not connect to $host: $#";
print "<pre>".$ftp->message ."</pre><br>\n";
$ftp->login($user,$pass) or die sprintf "Could not login: %s", $ftp->message;
print "<pre>".$ftp->message ."</pre><br>\n";
my $cur = $ftp->pwd();
my $new = $ftp->cwd($path);
if ($cur == $new) {
$ftp->quit;
print "Directory not found, exiting.\n";
} else {
if ($ftp->size($path.'/'.$filename) >= 0) {
$ftp->get($path.'/'.$filename) or die $ftp->message;
print "<pre>".$ftp->message ."</pre><br>\n";
print "File downloaded with success." if (-e $filename);
} else {
print "File not found.\n";
}
}
$ftp->quit;
i've changed the code a little you can put this file on usjoc.com and run it on the browser it wil display every step of the communication until it gets the file from okseries.com.
All you have to do is change $path to the path of where the file is but do not end the directory name with a /
filename in case on $filename
$host = ftp ip or hostname
$uesr and $pass i guess you know what goes in
response from the url you asked to be viewed:
USJOC Entry Form on
The Club file name is EdmondSkunks1T.db
/home/content/o/k/s/okseries/html/database/EdmondSkunks1T.db
Supposedly opened /home/content/o/k/s/okseries/html/database/EdmondSkunks1T.db
Back to USJOC

Related

Perl parse email and attachments from Outlook inbox

I'm using Mail::IMAPClient to connect to our Outlook mail server. I can get the mail just fine and print the text version of that mail to a file. But I'm having trouble using MIME::Parser to parse through the email.
I've tried giving the parser a file handle to the text file that I wrote the email to. I've tried giving the parser just the text of the email but it won't work how I'm expecting it to work. The entity parts always equals 0.
When I dump the entity skeleton I get
Content-type: text/plain
Effective-type: text/plain
Body-file: NONE
--
I can see all of the parts of the email in the file. The two PDFs that are attached are there, encoded in base64, so I know that the script is actually retrieving the email and the attachments. I've also tried parse and parse_data.
my $msgCount = 0;
$msgCount = $imap->message_count();
#or abortMission("", "Could not get message count: ". $imap->LastError );
if ( $msgCount > 0 ) {
#get all the messages from the inbox folder
my #msgseqnos = $imap->messages
or abortMission("", "Could not retreive messages:". $imap->LastError);
my ($x, $bh, $attachment, $attachmentName);
foreach my $seqno ( #msgseqnos ) {
my $input_file;
my $parser = new MIME::Parser;
my $emailText = $imap->body_string($seqno) # should be the entire email as text.
or abortMission("", "Could not get message string: " . $imap->LastError);
$parser->ignore_errors(1);
$parser->output_to_core(1);
open my $emailFileHandle, ">", "invoiceText.txt";
print $emailFileHandle $emailText;
#$imap->message_to_file($emailFileHandle, $seqno);
my $entity = $parser->parse_data($emailText);
$entity->dump_skeleton;
if ( $entity->parts > 0 ) {
for ( my $i = 0; $i < $entity->parts; $i++ ) {
my $subentity = $entity->parts($i);
# grab attachment name and contents
foreach $x ( #attypes ) {
if ( $subentity->mime_type =~ m/$x/i ) {
$bh = $subentity->bodyhandle;
$attachment = $bh->as_string;
$attachmentName = $subentity->head->mime_attr('content-disposition.filename');
open FH, ">$attachmentName";
print FH $attachment;
close FH;
#push #attachment, $attachment;
#push #attname, $subentity->head->mime_attr('content-disposition.filename');
}
}
}
}
else {
stillAGo("eData VehicleInvoices problem", "Perl can't find an attachment in an email in the VehicleInvoices folder of eData email address");
}
close $emailFileHandle;
# say $emailText;
# next;
#open OUT_FILE, ">invoiceText.txt";
#print OUT_FILE $emailText;
#print OUT_FILE $imap->bodypart_string($seqno,1);
#close OUT_FILE;
#print $emailText;
}
}
I'm trying to retrieve the attachments from emails automatically and save them to disk to be processed by another job.
I'd like to include the invoiceText.txt file so people can see the actual output but it's 1200 lines long. I'm not sure where to upload a file to link in here.
The body_string method doesn't return the entire email. As the documentation describes, and the name implies, it returns the body of the message, excluding the headers. That is why dump_skeleton shows no headers apart from the defaults
What you probably want, although I haven't tried it, is message_string, which does return the entire email
I see you've used message_to_file but commented it out. That would probably have worked if you got MIME::Parse to read from the file

Downloading attachment from Exchange message with Perl

I am automatically downloading mails from an Exchange 2010 server via perl. So far I have managed to access the message via Exchange Web Services (EWS) and parse headers. Now I wonder how I can download the attachments of a message to a local temporary folder.
I am new to Perl language and cannot find the source code or documentation for the message data structure. Any help is appreciated.
use Email::Folder::Exchange;
use Email::Simple;
# some more code here....
my $folder = Email::Folder::Exchange->new($url, $user, $pass);
for my $message ($folder->messages) {
if ($message->header('Subject') =~ /Downloadable Message/) {
// How to access message's attachments?
}
}
So basically the trick is to convert the Email::Simple to Email::MIME and use Email::MIME::Attachment::Stripper to parse through each attachment. Easy ;-)
! I only copied the relevant parts... so you might need to extend it a little for reuse.
use Email::Folder::Exchange;
use Email::Simple;
use Email::MIME::Attachment::Stripper;
# some more code here....
my $folder = Email::Folder::Exchange->new($url, $user, $pass);
for my $message ($folder->messages) {
my $tmpMsg = Email::MIME->new($message->as_string);
my $stripper = Email::MIME::Attachment::Stripper->new($tmpMsg);
for my $a ($stripper->attachments()) {
next if $a->{'filename'} !~ /csv/i; #only csv attachments
my $tempdir = "C:\\temp\\";
my $tmpPath = $tmpdir . $a->{'filename'};
# Save file to temporary path
my $f = new IO::File $tmpPath, "w" or die "Cannot create file " . $tmpPath;
print $f $a->{'payload'};
}
}

Perl to parse email, change "From:" header, send onwards

I wish I was lying, but I've spent several months trying to get this to work and I have to admit defeat on my perl scripting skills. I'm at a loss to make this work and need help (for which I wil be very grateful).
The background:
I am running a discussion email list using a third party Listserv. I want to change the "From" header on incoming emails to an address at my domain, by doing a database lookup for the email address, and then adding the users name and company code to the From header, and sending it on.
For example, Super Dave , is changed to David Smith (ABC - LON) , and then the list members will see that header instead of whatever he has chosen as his "From free text".
The script I have developed works very well ... except that more complex emails seem to stun it. Right now the script takes a text version of the email, strips out all the MIME parts and html bits, and changes the header. If it encounters an email format thats new to it (and I havent written a code line to handle), it stops. I could continue fixing each type of email coming in, but I think thats overkill - I need to get back to the KISS method.
Note: the database lookup is without issue. The problem is in the way the email body finally arrives at the listserver.
Instead of this, I want to leave the original email untouched, but just change the From header. Nothing else. Is there any way to do that? Here is (the salient part of) the script.
What Im after is a much simpler method to search the email for the from Header, change it to another value, and then send it on.
Thoughts?
$connect = DBI->connect($dsn, $user, $pw);
open FH, ">mail.txt" or die "can't open mail.txt: $!";
while ( $_ = <STDIN>) {
print FH "$_";
}
close(FH);
$file_content = `cat 'mail.txt' | grep -m1 From |tail -n+1`;
chomp($file_content);
$from = `echo "$file_content"| sed -e "s/.*<//;s/>.*//"`;
chomp($from);
$subject=`cat mail.txt |grep -m1 Subject| sed -e "s/.*Subject: //"`;
chomp($subject);
system('./body.sh');
$encoded=`cat body.txt`;
#Decode the mail and save output to dbody.txt. Still have header+body at this stage.
$body=decode_qp($encoded);
open FF, ">dbody.txt" or die $!;
print FF $body;
close FF;
#If body still has headers, Look for first blank line, and delete all before - this is the body
$bodycheck =`cat dbody.txt`;
if ($bodycheck =~ /Message-Id/ ){
$bodyfinal= `sed '0,/^\$/d' dbody.txt`;
} else {
$bodyfinal =$bodycheck
}
#Save the output to bodyfinal.txt
open FF, ">bodyfinal.txt" or die $!;
print FF $bodyfinal;
close FF;
#THIS SECTION contains code to query the database with the original FROM email address
#get username and domain and then change to lower case for the query
$case_username = substr($from, 0, index($from, '#'));
$m_username = lc($case_username);
$case_domain = substr($from, index($from, '#')+1);
$m_domain = lc($case_domain);
#print "\n##############$m_username\#$m_domain#################\n";
$query = "select user_real_name, company_code, location_code from user where user_email='$m_username\#$m_domain'";
$query_handle = $connect->prepare($query);
$query_handle->execute() or die $DBI::errstr;
#result=$query_handle->fetchrow_array();
print "\n#result\n";
##Forward the mail
sub sendEmail
{
my ($to, $from_sub, $subject, $message) = #_;
my $sendmail = '/usr/sbin/sendmail';
open(MAIL, "|$sendmail -oi -t");
print MAIL "From: $from_sub\n";
print MAIL "To: $to\n";
print MAIL "Subject: $subject\n\n";
print MAIL "$message\n";
close(MAIL);
}
{my $msg = MIME::Lite->new
(
Subject => "$subject",
From => "$result[0] ($result[1]/$codes[0]-$result[2])<listmail#>",
To => 'opg#maillist.com',
Type => 'text/plain',
Encoding => '7bit',
Data => "From: $result[0]/$result[1]-$codes[0]/$result[2] \n________________________________________________ \n \n$bodyfinal \n"
);
$msg->send();
}
To only answer "what is a simple method to search some file for a From: header,
change it to another value, and send it on?": use Tie::File;
Given a file named 'email' that contains the example headers from this page,
#! /usr/bin/env perl
use common::sense;
use Tie::File;
tie my #f, 'Tie::File', 'email' or die $!;
for (#f) {
if (/^From:/) {
say "old: $_";
s/(?<=^From:).*$/ A New Sender <anewsender\#ans.com>/;
say "new: $_";
last
}
}
untie #f;
Output:
$ perl tie-ex
old: From: Taylor Evans <example_from#dc.edu>
new: From: A New Sender <anewsender#ans.com>
$ grep ^From email
From: A New Sender <anewsender#ans.com>
Mind, there's all kinds of wrong with this. Headers don't need to be neatly on one line; there can be more than one From: header (by someone else's scripting error, for instance); there can even be no From: header in the headers and then a From: randomly in the body. Spammers do strange things. But if your original code already contains these limitations and you're happy enough with them, try this.
Meanwhile, there are already great Perl modules that handle mail. Take a look through the Email:: modules listed here.

Perl - How to get the email address from the FROM part of header?

I am trying to set up this script for my local bands newsletter.
Currently, someone sends an email with a request to be added, we manually add it to newsletter mailer I set up.
(Which works great thanks to help I found here!)
The intent now is to have my script below log into the email account I set up for the list on our server, grab the info to add the email automatically.
I know there are a bunch of apps that do this but, I want to learn myself.
I already have the "add to list" working when there is an email address returned from the header(from) below BUT, sometimes the header(from) is a name and not the email address (eg "persons name" is returned from persons name<email#address> but, not the <email#address>.)
Now, I am not set in stone on the below method but, it works famously... to a point.
I read all the docs on these modules and there was nothing I could find to get the darn email in there all the time.
Can someone help me here? Verbose examples are greatly appreciated since I am struggling learning Perl.
#!/usr/bin/perl -w
##########
use CGI;
use Net::IMAP::Simple;
use Email::Simple;
use IO::Socket::SSL; #optional i think if no ssl is needed
use strict;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
######################################################
# fill in your details here
my $username = '#########';
my $password = '#############';
my $mailhost = '##############';
#######################################################
print CGI::header();
# Connect
my $imap = Net::IMAP::Simple->new($mailhost, port=> 143, use_ssl => 0, ) || die "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";
# Log in
if ( !$imap->login( $username, $password ) ) {
print STDERR "Login failed: " . $imap->errstr . "\n";
exit(64);
}
# Look in the INBOX
my $nm = $imap->select('INBOX');
# How many messages are there?
my ($unseen, $recent, $num_messages) = $imap->status();
print "unseen: $unseen, <br />recent: $recent, <br />total: $num_messages<br />\n\n";
## Iterate through unseen messages
for ( my $i = 1 ; $i <= $nm ; $i++ ) {
if ( $imap->seen($i) ) {
my $es = Email::Simple->new( join '', #{ $imap->top($i) } );
printf( "[%03d] %s\n\t%s\n", $i, $es->header('From'), $es->header('Subject'));
print "<br />";
next;
}## in the long version these are pushed into different arrays for experimenting purposes
else {
my $es = Email::Simple->new( join '', #{ $imap->top($i) } );
printf( "[%03d] %s\n\t%s\n", $i, $es->header('From'), $es->header('Subject'));
print "<br />";
}
}
# Disconnect
$imap->quit;
exit;
use Email::Address;
my #addresses = Email::Address->parse('persons name <email#address>');
print $addresses[0]->address;
The parse method returns an array, so the above way works for me.
I'm making this a separate answer because even though this information is hidden in the comments of the accepted answer, it took me all day to figure that out.
First you need to get the From header using something like Email::Simple. THEN you need to extract the address portion with Email::Address.
use Email::Simple;
use Email::Address;
my $email = Email::Simple->new($input);
my $from = $email->header('From');
my #addrs = Email::Address->parse($from);
my $from_address = $addrs[0]->address; # finally, the naked From address.
Those 4 steps in that order.
The final step is made confusing by the fact that Email::Address uses some voodoo where if you print the parts that Email::Address->parse returns, they will look like simple strings, but they are actually objects. For example if you print the result of Email::Address->parse like so,
my #addrs = Email::Address->parse($from);
foreach my $addr (#addrs) { say $addr; }
You will get the complete address as output:
"Some Name" <address#example.com>
This was highly confusing when working on this. Granted, I caused the confusion by printing the results in the first place, but I do that out of habit when debugging.

How can my previously untainted data become tainted again?

I have a bit of a mystery here that I am not quite understanding the root cause of. I am getting an 'Insecure dependency in unlink while running with -T switch' when trying to invoke unlink from a script. That is not the mystery, as I realize that this means Perl is saying I am trying to use tainted data. The mystery is that this data was previously untainted in another script that saved it to disk without any problems.
Here's how it goes... The first script creates a binary file name using the following
# For the binary file upload
my $extensioncheck = '';
my $safe_filename_characters = "a-zA-Z0-9_.";
if ( $item_photo )
{
# Allowable File Type Check
my ( $name, $path, $extension ) = fileparse ( $item_photo, '\..*' );
$extensioncheck = lc($extension);
if (( $extensioncheck ne ".jpg" ) && ( $extensioncheck ne ".jpeg" ) &&
( $extensioncheck ne ".png" ) && ( $extensioncheck ne ".gif" ))
{
die "Your photo file is in a prohibited file format.";
}
# Rename file to Ad ID for adphoto directory use and untaint
$item_photo = join "", $adID, $extensioncheck;
$item_photo =~ tr/ /_/;
$item_photo =~ s/[^$safe_filename_characters]//g;
if ( $item_photo =~ /^([$safe_filename_characters]+)$/ ) { $item_photo = $1; }
else { die "Filename contains invalid characters"; }
}
$adID is generated by the script itself using a localtime(time) function, so it should not be tainted. $item_photo is reassigned using $adID and $extensioncheck BEFORE the taint check, so the new $item_photo is now untainted. I know this because $item_photo itself has no problem with unlink itself latter in the script. $item_photo is only used long enough to create three other image files using ImageMagick before it's tossed using the unlink function. The three filenames created from the ImageMagick processing of $item_photo are created simply like so.
$largepicfilename = $adID . "_large.jpg";
$adpagepicfilename = $adID . "_adpage.jpg";
$thumbnailfilename = $adID . "_thumbnail.jpg";
The paths are prepended to the new filenames to create the URLs, and are defined at the top of the script, so they can't be tainted as well. The URLs for these files are generated like so.
my $adpageURL = join "", $adpages_dir_URL, $adID, '.html';
my $largepicURL = join "", $adphotos_dir_URL, $largepicfilename;
my $adpagepicURL = join "", $adphotos_dir_URL, $adpagepicfilename;
my $thumbnailURL = join "", $adphotos_dir_URL, $thumbnailfilename;
Then I write them to the record, knowing everything is untainted.
Now comes the screwy part. In a second script I read these files in to be deleted using the unlink function, and this is where I am getting my 'Insecue dependency' flag.
# Read in the current Ad Records Database
open (ADRECORDS, $adrecords_db) || die("Unable to Read Ad Records Database");
flock(ADRECORDS, LOCK_SH);
seek (ADRECORDS, 0, SEEK_SET);
my #adrecords_data = <ADRECORDS>;
close(ADRECORDS);
# Find the Ad in the Ad Records Database
ADRECORD1:foreach $AdRecord(#adrecords_data)
{
chomp($AdRecord);
my($adID_In, $adpageURL_In, $largepicURL_In, $adpagepicURL_In, $thumbnailURL_In)=split(/\|/,$AdRecord);
if ($flagadAdID ne $adID_In) { $AdRecordArrayNum++; next ADRECORD1 }
else
{
#Delete the Ad Page and Ad Page Images
unlink ("$adpageURL_In");
unlink ("$largepicURL_In");
unlink ("$adpagepicURL_In");
unlink ("$thumbnailURL_In");
last ADRECORD1;
}
}
I know I can just untaint them again, or even just blow them on through knowing that the data is safe, but that is not the point. What I want is to understand WHY this is happening in the first place, as I am not understanding how this previously untainted data is now being seen as tainted. Any help to enlighten where I am missing this connection would be truly appreciated, because I really want to understand this rather than just write the hack to fix it.
Saving data to a file doesn't save any "tainted" bit with the data. It's just data, coming from an external source, so when Perl reads it it becomes automatically tainted. In your second script, you will have to explicitly untaint the data.
After all, some other malicious program could have changed the data in the file before the second script has a chance to read it.