I have a CGI which gets a File uploaded and does something with it.
I would like a Unittest for the fileupload functionality
After reading http://www.perlmonks.org/?node_id=249917
I tried to adapt the code in CGI.pm's t/upload.t
{
%ENV = (
%ENV,
'SCRIPT_NAME' => '/data.cgi',
'SERVER_NAME' => 'localhost',
'HTTP_CONNECTION' => 'TE, close',
'REQUEST_METHOD' => 'POST',
'SCRIPT_URI' => 'http://localhost/data.cgi',
'CONTENT_LENGTH' => '160',
'SCRIPT_FILENAME' => '/var/www/cgi-bin/data.cgi',
'SERVER_SOFTWARE' => 'Apache/1.3.27 (Unix) ',
'HTTP_TE' => 'deflate,gzip;q=0.3',
'QUERY_STRING' => '',
'REMOTE_PORT' => '1855',
'HTTP_USER_AGENT' => 'libwww-perl/5.69',
'SERVER_PORT' => '80',
'REMOTE_ADDR' => '127.0.0.1',
'CONTENT_TYPE' => 'multipart/form-data; boundary=xYzZY',
'SERVER_PROTOCOL' => 'HTTP/1.1',
'PATH' => '/usr/local/bin:/usr/bin:/bin',
'REQUEST_URI' => '/data.cgi',
'GATEWAY_INTERFACE' => 'CGI/1.1',
'SCRIPT_URL' => '/data.cgi',
'SERVER_ADDR' => '127.0.0.1',
'DOCUMENT_ROOT' => '/var/www/html',
'HTTP_HOST' => 'localhost'
);
local *STDIN;
open STDIN, '<test.txt' or die 'argh';
binmode STDIN;
$cgi = new CGI;
run()
}
test.txt:
--xYzZY
Content-Disposition: form-data; name="hello_world"; filename="goodbye_world.txt"
Content-Length: 13
Content-Type: text/plain
Goodbye World!
--xYzZY--
Now i get "400 Bad request (malformed multipart POST)" in cgi_error when i try to access the filehandle with
our $cgi;
sub run() {
$cgi = new CGI unless $cgi;
my $upload_fh = $cgi->upload('upload');
}
Related
This is driving me nuts. I must be missing something stupid. I have the following sub:
sub send_email {
use MIME::Lite;
use MIME::Base64;
use Encode;
my $to = 'support#foobar.co.uk'; #$rec{'Email'};
my $from = $admin_email;
my $subject = "webform $html_title";
my $html = "some test <b>message</b> foo bar test";
my $text = "some test message some plain version";
# $html = decode( 'utf-8', $html );
# $text = decode( 'utf-8', $text );
my ($status,$attach,$newfile);
use Email::MIME;
use Email::Address::XS;
use Email::Sender::Simple qw(sendmail);
use IO::All;
use GT::MIMETypes;
# multipart message
my #alternative_parts = (
Email::MIME->create(
body_str => $text,
attributes => {
encoding => 'quoted-printable',
content_type => "text/plain",
disposition => "inline",
charset => "UTF-8",
}
),
Email::MIME->create(
body_str => $html,
attributes => {
encoding => 'quoted-printable',
charset => "UTF-8",
content_type => "text/html",
disposition => "inline",
}
)
);
my #attachment_parts;
my $attach = "/path/to/file/tables.cgi";
if ($attach) {
my $filename = (reverse split /\//, $attach)[0]; # also change
+d in body => below
my $content;
my $mime = GT::MIMETypes::guess_type($filename);
push #parts, Email::MIME->create(
attributes => {
filename => $filename,
content_type => $mime,
encoding => "base64",
name => $filename,
attachment => "attachment"
},
body => io( $attach )->binary->all,
)
}
my $email = Email::MIME->create(
header_str => [
From => $from,
To => [ $to ],
Subject => $subject
],
parts => \#parts,
attributes => {
encoding => 'base64',
charset => "UTF-8",
content_type => "multipart/multipart",
#disposition => "inline",
}
);
sendmail($email->as_string);
print "EMAIL: " . $email->as_string. "\n\n"; # print for andy
}
What it needs to do is include both a plain text and HTML body of the email. Then, also attached is a file (a .cgi just for testing :)).
While the emails come through fine on Gmail - it buggers up on Outlook/Thunderbird. I have a feeling its the way I'm breaking up the "parts". From my understanding, you need a "main" body part, which can be split into a plain text and HTML version - and then the attachment as another part of the main "part". I'm not too sure how to achieve this though?
This is how the "debug_structure" comes out:
Structure: + multipart/multipart; boundary="15846317930.c94ff7.26547"
+ text/plain; charset="UTF-8"
+ text/html; charset="UTF-8"
+ text/plain; attachment="attachment"; name="tables.cgi"
UPDATE: As suggested, I'm now trying nested parts:
# multipart message
my #message_parts = (
Email::MIME->create(
body_str => $text,
attributes => {
encoding => 'quoted-printable',
content_type => "text/plain",
disposition => "inline",
charset => "UTF-8",
}
),
Email::MIME->create(
body_str => $html,
attributes => {
encoding => 'quoted-printable',
charset => "UTF-8",
content_type => "text/html",
disposition => "inline",
}
)
);
my #all_parts;
push #all_parts, Email::MIME->create(
parts => [\#message_parts], # add all the message parts into here...
attributes => {
content_type => "multipart/alternative"
}
);
my $attach = "/home/user/web/public_html/cgi-bin/admin/tables.cgi";
if ($attach) {
my $filename = (reverse split /\//, $attach)[0]; # also changed in body => below
# better to use GT::MIMETypes if you have it with Fileman (pretty sure you do?)
my $mime = GT::MIMETypes::guess_type($filename);
push #all_parts, Email::MIME->create(
attributes => {
filename => $filename,
content_type => $mime,
encoding => "base64",
name => $filename
},
body => io( $attach )->binary->all,
)
}
my $email = Email::MIME->create(
header_str => [
From => $from,
To => [ $to ],
Subject => $subject
],
parts => [\#all_parts],
attributes => {
encoding => 'base64',
content_type => "multipart/mixed"
}
);
print qq|Structure: | . $email->debug_structure. "\n\n";
But I get an error:
Can't call method "as_string" on unblessed reference at
/usr/local/share/perl/5.22.1/Email/MIME.pm line 771.
Line 771 is in parts_set in Email::MIME - so I must be doing something wrong setting?
UPDATE 2: Thanks Steffen for your help! So this is the final working code, with the correct structure:
use Email::MIME;
use Email::Address::XS;
use Email::Sender::Simple qw(sendmail);
use IO::All;
use GT::MIMETypes;
my $to = 'support#foo.co.uk'; #$rec{'Email'};
my $from = $admin_email;
my $subject = "some title";
my $html = "some test <b>message</b> foo bar test";
my $text = "some test message some plain version";
$html = decode( 'utf-8', $html );
$text = decode( 'utf-8', $text );
# multipart message
my #message_parts = (
Email::MIME->create(
body_str => $text,
attributes => {
encoding => 'quoted-printable',
content_type => "text/plain",
disposition => "inline",
charset => "UTF-8",
}
),
Email::MIME->create(
body_str => $html,
attributes => {
encoding => 'quoted-printable',
charset => "UTF-8",
content_type => "text/html",
disposition => "inline",
}
)
);
my #all_parts;
push #all_parts, Email::MIME->create(
parts => \#message_parts, # add all the message parts into here...
attributes => {
content_type => "multipart/alternative"
}
);
my $attach = "/home/user/web/foo.co.uk/public_html/cgi-bin/admin/tables.cgi";
if ($attach) {
my $filename = (reverse split /\//, $attach)[0]; # also changed in body => below
# better to use GT::MIMETypes if you have it with Fileman (pretty sure you do?)
my $mime = "plain/text"; # hard coded in this example, but you want to set the correct type for the attachment type
push #all_parts, Email::MIME->create(
attributes => {
filename => $filename,
content_type => $mime,
encoding => "base64",
name => $filename
},
body => io( $attach )->binary->all,
)
}
my $email = Email::MIME->create(
header_str => [
From => $from,
To => [ $to ],
Subject => $subject
],
parts => \#all_parts,
attributes => {
encoding => 'base64',
content_type => "multipart/mixed"
}
);
print qq|Structure: | . $email->debug_structure. "\n\n";
sendmail($email->as_string);
The structure now comes out correctly as:
Structure: + multipart/mixed; boundary="15846944601.d6aF.12245"
+ multipart/alternative; boundary="15846944600.d79D2A2.12245"
+ text/plain; charset="UTF-8"
+ text/html; charset="UTF-8"
+ text/plain; name="tables.cgi"
There is no such thing as a multipart/multipart which you use. Your mail should have the following structure instead:
multipart/mixed
|- multipart/alternative << mail client will choose which of the parts to display
| | text/plain << the mail as plain text
| | text/html << the mail as HTML
|- text/plain << the attachment
As for the attachment it might be useful to choose a content-type which better matches the attachment type. If the attachment is actually plain text then text/plain might be fine but if it is an image, office document, archive ... different content-type should be used.
Apart from that neither encoding nor charset nor disposition make any sense in a multipart definition. These are only relevant for final parts (text/plain etc), not for container parts (multipart/whatever)
attributes => {
encoding => 'base64',
charset => "UTF-8",
content_type => "multipart/multipart",
#disposition => "inline",
}
Can anyone please help with attaching two text files while sending email using Email::Simple. I am able to receive mail but without the attachments
I have tried a lot but couldn't make it work, not sure if I am having the incorrect modules. I did not want to use MIME::Lite because of the recommendation by the creator of MIME::Lite. I basically wanted to use my own SMTP details, and got Email::Sender as recommendation. Everything works except the attachment.
use strict;
use warnings;
use Email::Sender::Simple qw(sendmail);
use Email::Sender::Transport::SMTP ();
use Email::Simple ();
use Email::Simple::Creator ();
use Email::Sender::Transport::SMTP::TLS;
use Email::MIME;
use IO::All;
my $transport = Email::Sender::Transport::SMTP::TLS->new({
host => 'smtp.office365.com',
port => 587,
sasl_username => 'abcsender#abc.com',
sasl_password => 'P#ssw0rd#123',
username => 'abcsender#abc.com',
password => 'P#ssw0rd#123'
});
my #parts = (
Email::MIME->create(
attributes => {
content_type => "text/plain",
filename => "/tmp/ERROR1493720941.log",
charset => "US-ASCII",
disposition =>"attachment",
},
body => io( "/tmp/ERROR1493720941.log" )->all,
),
Email::MIME->create(
attributes => {
content_type => "text/plain",
filename => "/tmp/FAILED1493720941.log",
charset => "US-ASCII",
disposition =>"attachment",
},
body => io( "/tmp/FAILED1493720941.log" )->all,
),
);
my $email = Email::Simple->create(
header => [
To => 'gsrivastava#abc.com',
From => 'abcsender#abc.com',
Subject => 'Hi!',
],
body => "Hello",
parts => [ #parts ],
);
sendmail($email, { transport => $transport });
As asked by #DaveCross in comment, here is the output of $email->as_string
$VAR1 = 'To: gsrivastava#abc.com^M
From: abcsender#abc.com^M
Subject: Hi!^M
Date: Sun, 7 May 2017 07:58:46 -0400^M
^M
Hello^M
Turns out that this is a pretty simple mistake to make. You are creating a MIME email, but when you get to creating the actual email object, you use this code:
my $email = Email::Simple->create(
header => [
To => 'gsrivastava#abc.com',
From => 'abcsender#abc.com',
Subject => 'Hi!',
],
body => "Hello",
parts => [ #parts ],
);
Email::Simple isn't intended for MIME mail messages, so it doesn't understand the parts attribute and ignores it. To create a MIME email, you need to use Email::MIME.
my $email = Email::MIME->create(
header => [
To => 'gsrivastava#abc.com',
From => 'abcsender#abc.com',
Subject => 'Hi!',
],
parts => [ #parts ],
);
Note that I've removed the body attribute. MIME emails can't have both parts and a body. The solution is to add another element to #parts that contains your body text.
my #parts = (
Email::MIME->create(
attributes => {
content_type => 'text/plain',
disposition => 'attachment',
charset => 'US-ASCII',
encoding => 'quoted-printable',
},
body_str => 'Hello',
),
...
);
I have written a wrapper for an API. Previously I'd worked on simple string-based GET requests to PHP scripts using Perl.
As part of analysing the response, I have to analyse the following data which appears to be an object. Unfortunately, I'm not sure how to extract usable data from this.
print Dumper on the data returns this:
$VAR1 = bless( {
'_rc' => '200',
'_request' => bless( {
'_uri_canonical' => bless( do{\(my $o = 'http://example.com/?list=1&token=h_DQ-3lru6uy_Zy0w-KXGbPm_b9llY3LAAAAALSF1roAAAAANxAtg49JqlUAAAAA')}, 'URI::http' ),
'_content' => '',
'_uri' => $VAR1->{'_request'}{'_uri_canonical'},
'_method' => 'GET',
'_headers' => bless( {
'accept-charset' => 'iso-8859-1,*,utf-8',
'accept' => 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*',
'cookie' => 'GUID=cHoW3DLOljP4K9LzposM',
'user-agent' => 'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.7) Gecko/20041107 Firefox/1.0',
'authorization' => 'Basic YWRtaW46bmljb2xl',
'cookie2' => '$Version="1"',
'::std_case' => {
'cookie' => 'Cookie',
'cookie2' => 'Cookie2'
},
'accept-language' => 'en-US'
}, 'HTTP::Headers' )
}, 'HTTP::Request' ),
'_headers' => bless( {
'client-peer' => 'myip:8085',
'content-type' => 'text/plain',
'cache-control' => 'no-cache',
'connection' => 'keep-alive',
'client-date' => 'Sat, 18 Jul 2015 12:41:00 GMT',
'::std_case' => {
'client-response-num' => 'Client-Response-Num',
'set-cookie2' => 'Set-Cookie2',
'client-date' => 'Client-Date',
'client-peer' => 'Client-Peer',
'set-cookie' => 'Set-Cookie'
},
'client-response-num' => 1,
'content-length' => '8684'
}, 'HTTP::Headers' ),
'_msg' => 'OK',
'_protocol' => 'HTTP/1.1',
'_content' => '{"build":30470,"torrents": [
["043CC5FA0C741CDAD9D2E5CC20DF64A4A400FA34",136,"Epi.S01E03.720p.HDTV.x264-IMMERSE[rarbg]",690765843,39,26951680,671744,24,0,0,0,"",0,1454,0,114,2436,1,663814163,"","","Stopped","512840d7",1437022635,0,"","/mydir/Epi.S01E03.720p.HDTV.x264-IMMERSE[rarbg]",0,"0368737A",false],
["097AA60280AE3E4BA8741192CB015EE06BD9F992",200,"Epi.S01E04.HDTV.x264-KILLERS[ettv]",221928759,1000,221928759,8890308649,40059,0,0,0,"",0,1461,0,4395,65536,-1,0,"","","Queued Seed","512840d8",1437022635,1437023190,"","/mydir/Epi.S01E04.HDTV.x264-KILLERS[ettv]",0,"8F52310A",false]],
"label": [],"torrentc": "350372445"
,"rssfeeds": []
,"rssfilters": []
}
',
'_msg' => 'OK',
'_protocol' => 'HTTP/1.1'
}, 'HTTP::Response' );
I would like to extract each of the following strings from the returned object
097AA60280AE3E4BA8741192CB015EE06BD9F992
200
Epi.S01E04.HDTV.x264-KILLERS[ettv]
Unfortunately, my understanding of objects in Perl is very elementary.
The original code which returns this data looks like this:
my $ua = LWP::UserAgent->new();
my $response = $ua->get( $url, #ns_headers );
print Dumper($response);
How can I work on the strings that of interest?
If you read the documentation for HTTP::Response, you will see that there is a content method, which will return the content of your HTTP message, and a decoded_content method that does the same but also decompresses the data if it happens to be compressed (in your case the data is uncompressed.)
In this case it looks like the content is encoded as JSON data, so you will also need to load the JSON module to decode it into a Perl data structure
For example
use JSON 'from_json';
my $content = from_json $response->decoded_content;
my $torrents = $content->{torrents};
for my $torrent ( #$torrents ) {
say for #$torrent[0,1,2];
say '';
}
output
043CC5FA0C741CDAD9D2E5CC20DF64A4A400FA34
136
Epi.S01E03.720p.HDTV.x264-IMMERSE[rarbg]
097AA60280AE3E4BA8741192CB015EE06BD9F992
200
Epi.S01E04.HDTV.x264-KILLERS[ettv]
I need show the "content" that is in the hash , i test with : $c->header("content") , but but shows nothing , but in the content hash value if this.
as I can show _content?
The hash
<pre>
$VAR1 = bless(
{
'_protocol' => 'HTTP/1.1',
'_content' => '-----------------------------8283483225031
Content-Disposition: form-data; name="archivo"; filename="GFWLIVESetupLog.txt"
Content-Type: text/plain
l i v e R e d i s t : 0
G F W L C l i e n t : 0
-----------------------------8283483225031
Content-Disposition: form-data; name="destino"
C:/perl/test.txt
-----------------------------8283483225031--
',
'_uri' => bless(
do {
\(
my $o =
'http://localhost/shell.php?uploa
d='
);
},
'URI::http'
),
'_headers' => bless(
{
'user-agent' => 'Mozilla/5.0 (Windows NT
5.1; rv:19.0) Gecko/20100101 Firefox/19.0',
'accept' => 'text/html,application/xhtml
+xml,application/xml;q=0.9,*/*;q=0.8',
'accept-language' => 'es-ar,es;q=0.8,en-
us;q=0.5,en;q=0.3',
'cookie' => 'PHPSESSID=a8bkktvsripf6agpi
fnma61qq4',
'content-length' => '378',
'host' => 'localhost',
'via' => '1.1 doddy-701c8cb49 (HTTP::Pro
xy/0.20)',
'content-type' => 'multipart/form-data;
boundary=---------------------------8283483225031',
'x-forwarded-for' => '127.0.0.1',
'referer' => 'http://localhost/shell.php
?upload='
},
'HTTP::Headers'
),
'_method' => 'POST'
},
'HTTP::Request'
);
</pre>
The source :
use HTTP::Proxy;
use HTTP::Proxy::BodyFilter::simple;
use HTTP::Proxy::BodyFilter::complete;
use Data::Dumper;
my $server = HTTP::Proxy->new(port=>8080);
$server->host();
$server->push_filter(mime=>undef,response => HTTP::Proxy::BodyFilter::complete->new());
$server->push_filter(
mime=>undef,
request=>HTTP::Proxy::BodyFilter::simple->new(\&enable),
response => HTTP::Proxy::BodyFilter::simple->new(\&enable2));
$server->start();
sub enable {
my($a,$b,$c,$d,$e) = #_;
print $c->header("content");
#print Dumper $c;
}
sub enable2 {
my ($j,$k,$l,$m,$n) = #_;
print $$k;
}
pd : excuse my bad English
The content is not in the headers. In your dumper output, the headers is the HTTP::Headers object denoted by the _headers key. You want to call the content method.
$c->content;
See the HTTP::Request documentation for a full list of available methods.
Why does the attachment(ca. 110KiB) split up in 10 parts(ca. 11KiB) when I send it with this script using Email::MIME?
#!/usr/bin/env perl
use warnings; use strict;
use Email::Sender::Transport::SMTP::TLS;
my $mailer = Email::Sender::Transport::SMTP::TLS->new(
host => 'smtp.my.host',
port => 587,
username => 'username',
password => 'password',
);
use Email::MIME::Creator;
use IO::All;
my #parts = (
Email::MIME->create(
attributes => {
content_type => 'text/plain',
disposition => 'inline',
encoding => 'quoted-printable',
charset => 'UTF-8',
},
body => "Hello there!\n\nHow are you?",
),
Email::MIME->create(
attributes => {
filename => "test.jpg",
content_type => "image/jpeg",
disposition => 'attachment',
encoding => "base64",
name => "test.jpg",
},
body => io( "test.jpg" )->all,
),
);
my $email = Email::MIME->create(
header => [ From => 'my#address', To => 'your#address', Subject => 'subject', ],
parts => [ #parts ],
);
eval {
$mailer->send( $email, {
from => 'my#address',
to => [ 'your#address' ],
} );
};
die "Error sending email: $#" if $#;
I had a similar case using MIME::Lite and Net::SMTP::TLS (using TLS rather than SSL because connection to smtp.gmail.com was not working with SSL) in my Perl script to send email with spreadsheet attachments through a gmail account, whereby the spreadsheet attachments were being broken up into multiple 10kb files.
Solution was to replace Net::SMTP::TLS with Net::SMTP::TLS::ButMaintained, which I hadn't initially seen. Newer TLS module works great.
I can offer you a workaround: using MIME::Lite instead