Hi I'm trying to upload a file using CGI and although the CGI script runs, the file that is created is empty.
I have a html file which gets the file name and passes it to a cgi script:
<html>
<body>
<form enctype="multipart/form-data" action="cgi-bin/upload.pl" method="POST">
<input type="FILE" name="file">
<input type="submit">
</form>
</body>
</html>
The cgi script is as follows:
#!/usr/bin/perl -w
use strict;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use CGI;
print "Content-type: text/html\n\n";
my $cgi = new CGI;
my $dir = 'sub';
my $name = $cgi->param('file');
print "name: $name <br />\n";
open(LOCAL, ">$dir/$name") or die "error: failed to open $dir/$name\n";
my $file_handle = $cgi->upload('file');
die "file_handle not defined\n" unless(defined($file_handle));
while(<$file_handle>) {
print $_;
print LOCAL $_;
}
close($file_handle);
close(LOCAL);
print "done\n";
The cgi script runs OK, produces no warnings, manages to create a local file and correctly gets the remote file name. However, the script appears not to read any data from the file or write any data into the local file which is empty.
I'm definitely uploading a file that contains multiple lines of data but the output of the cgi script is as follows:
name: tmp.txt
done
Any help greatly appreciated...
You might want to try using the binmode command on the FH.
Here's a Perl script that I use as a starting point for a CGI form that uploads files (displays the form and does the upload):
#!/usr/bin/perl
use strict;
use warnings;
use POSIX;
use CGI::Pretty qw(:standard -any -no_xhtml -oldstyle_urls *center);
use CGI::Carp qw(fatalsToBrowser set_message);
use Upload;
# Constants
my $FILE_DIR_INTERNAL = 'Z:\webroot\tmp';
# Variables
my $ACTION = param('action') || "";
if (! $ACTION) { UploadForm() }
elsif ($ACTION eq "UploadFile") {
my $file = UploadFile($FILE_DIR_INTERNAL, 1);
print "File uploaded to $file\n<pre>";
open(F, "$file");
while(<F>) { print }
close(F);
}
And here's the Perl module used by that script:
package Upload;
use strict;
use warnings;
use POSIX;
use File::Copy;
use CGI::Pretty qw(:standard -any -no_xhtml -oldstyle_urls *center);
use CGI::Carp qw(fatalsToBrowser); # supposed to echo STDERR to browser, too
use Exporter;
our $VERSION = do{ q$Revision: 1.5 $ =~ /(\d+)\.(\d*)([^ ]*)/; sprintf "%d.%02d%s", $1, $2, $3; };
our #ISA = qw(Exporter);
our #EXPORT = qw(UploadForm UploadFile);
my $FILE_UPLOAD_PARAM = "fileUploaded";
# *************************************************************************
# FUNCTION: UploadForm
# ARGUMENTS:
# RETURNS:
# NOTES: This subroutine displays the upload form.
# *************************************************************************
sub UploadForm {
print start_center;
print p("Upload a file from your computer:");
# Normally, I use the "get" method for forms (params show up in URL),
# but "post" is required for uploading files!
# Using "post" also requires that we pass parameters thru the hidden()
# commands down below, instead of in the URL.
print start_multipart_form({-method=>"post", -action=>script_name});
print filefield($FILE_UPLOAD_PARAM,"",50) . "\n";
# Hidden parameters are "sticky", so modify the existing "action" param,
# before trying to insert a new hidden "action" param.
# If you don't, CGI.pm will re-use the current "action" param.
param("action", "UploadFile");
print hidden("action") . "\n";
print p(submit("", "Upload File"));
print end_form;
print end_center;
}
# *************************************************************************
# FUNCTION: UploadFile
# ARGUMENTS:
# RETURNS:
# NOTES: This subroutine handles data "posted" thru the form
# created in UploadForm().
# *************************************************************************
sub UploadFile {
my $dir = shift || die "ERROR! No arg passed to UploadFile().\n";
my $overwrite = shift || 0;
my $TEMP_FH;
# The upload() function returns the filename and a file handle. See CGI.pm.
$_= $TEMP_FH = upload($FILE_UPLOAD_PARAM);
# What do all the regexes do? I wrote them, but I forgot. I think they
# strip off any path information (common in IE!) to get just the filename.
s/\w://;
s/([^\/\\]+)$//;
$_ = $1;
s/\.\.+//g;
s/\s+//g;
my $filename = $_;
my $serverFullFilename = "$dir/$filename";
if (! $filename) {
DisplayErrorPage("Illegal filename: '$filename'");
}
if ((! $overwrite) && (-e $serverFullFilename)) {
die "Unable to upload file. File '$filename' already exists.";
}
open(SERVER_FH,">$serverFullFilename") || die "Error opening $filename for writing.";
binmode SERVER_FH;
# Copy the file from the temp dir to the final location.
while (<$TEMP_FH>) {
print SERVER_FH;
}
close(SERVER_FH);
close($TEMP_FH);
if ((stat $serverFullFilename)[7] <= 0) {
unlink $serverFullFilename;
die "Unable to upload file '$filename'. This is usually due to the user specifying an invalid or unreadable file on the user's computer.";
}
return $serverFullFilename;
}
return 1;
Forgive any inconsistencies, as I had to cut out some site-specific stuff, but if I trimmed it all correctly, that should work "out of the box"
Related
I have the code as shown below. A BEGIN which loads the session or, if none is yet created, it creates one. But it doesn't do it all the time. It's a login script; If I enter the PIN and it's wrong, the script displays the login form again, which is submitted to this same script. Up to 3 attempts permitted but, it will fail to load the session, usually on attempt 2. Inconsistent so, please can anyone see what might be wrong and why is the session sometimes not loading.
I do have warnings enabled and I have shown that in the code.
I used to start the script with 'print $session->header' but, having changed to 'print $cgi->header;' I can see clearly that the session is undefined, when the script fails. I should add that, if I refresh the failed page perhaps as many as 5 times, the session does eventually reload with all data intact.
#!/usr/bin/perl
#use CGI::Carp qw/warningsToBrowser fatalsToBrowser/;
use strict;
use warnings 'all';
use CGI qw(:all);
use CGI::Session;
use Crypt::PasswdMD5;
use DBI;
use Data::Dumper;
my $cgi = CGI->new;
my $session;
my $sessions_dir_location;
my $session_id;
BEGIN{
unshift #INC, "/var/www/vhosts/example.com/subDomain.example.com/cgi-bin/library";
my $document_root = $ENV{'DOCUMENT_ROOT'};
$document_root =~ s/\///;
my ( $var
, $www
, $vhosts
, $domain
) = split ('/', $document_root, 5);
$sessions_dir_location = '/' . $var . '/' . $www . '/' . $vhosts . '/' . $domain;
$session = CGI::Session->load() or die CGI::Session->errstr();
if ( $session->is_expired ) {
print $session->header(),
$cgi->start_html(),
$cgi->p("Your session timed out! Refresh the screen to start new session!"),
$cgi->end_html();
exit(0);
}
if ( $session->is_empty ) {
$session = new CGI::Session(undef, undef,
{Directory=>"$sessions_dir_location/sessions_storage/"}) or die CGI::Session->errstr;
}
#add the library dir to #INC;
use lib do {
use Cwd 'realpath';
my ($dir) = __FILE__ =~ m{^(.*)/};
realpath("$dir/library");
};
use feature 'say';
use FindBin '$RealBin';
use lib $RealBin;
use lib "$RealBin/library";
}
my $self = $cgi->url;
my %login = $cgi->Vars;
print $cgi->header;
# capture and display warnings
local $SIG{__WARN__} = sub {
my $message = shift;
print $cgi->header;
print qq($message);
};
print qq(<pre>);
print Dumper \%login;
print qq(</pre>);
print qq(<pre>session);
print Dumper \$session; #undef
print qq(</pre>);
#next is line 141
my $session_stored_user_name = $session->param("entered_user_name");
Error message is this:
Can't call method "param" on an undefined value at /var/www/vhosts/example.com/subDomain.example.com/cgi-bin/dashboard-login/login-with-pin.pl line 141, <DAT> line 45.
Please, also, what or where is <DAT> line 45?
I am struck at this point since 1 day.
First am taking all file names .Then upload and collect all file handles.
Due to some reason, files are not uploading into /home/img folder correctly.
If uploaded, they are getting corrupted. Corrupted filesize shows as 0 bytes or 24 bytes.
Please provide assistance with upload part.
#!/usr/bin/perlml -Tw
use strict;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
my $cgi = CGI->new;
my $upload_dir = "/home/img";
my #raw_filenames = $cgi->param('photos');
my $filename_characters = 'a-zA-Z0-9_.-';
my $ext = "";
my $raw_filenames = "";
my $raw_fh = "";
my $single_filename = "";
my $single_io_handle = "";
my #all_io_handle = "";
my #all_filenames = "";
print "Content-type: text/html\n\n";
#Getting the filenames ready
foreach $raw_filenames (#raw_filenames) {
( $single_filename, undef, $ext ) = fileparse( $raw_filenames, qr{\..*} );
push( #all_filenames, "$single_filename" );
}
#This prints the ready list of filenames
print "#all_filenames\n <br>";
#Getting the filehandles ready
my #raw_fh = $cgi->upload('photos');
foreach $raw_fh (#raw_fh) {
$single_io_handle = $raw_fh->handle;
push( #all_io_handle, "$single_io_handle" );
}
#This prints the ready list of filehandles
print "#all_io_handle\n <br>";
The following test of CGI->upload works with html input multiple attribute.
I attempt to view the file size of each uploaded file both by the temp file and by reading it from disk:
#!/usr/bin/env perl
use strict;
use warnings;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
my $q = CGI->new();
my $msg = '';
if ( $q->request_method() eq 'POST' ) {
$msg .= '<table border=1 cellpadding=3 cellspacing=0><tr><th>File name</th><th>Temp size</th><th>Slurped size</th></tr>';
for my $file ( $q->upload('myfile') ) {
my $tempsize = -s $q->tmpFileName($file);
my $readsize = do {
my $fh = $file->handle();
binmode $fh;
local $/; # Slurp entire file
length <$fh>;
};
$msg .= '<tr><td>' . $q->escapeHTML($file) . "</td><td>$tempsize</td><td>$readsize</td></tr>";
}
$msg .= '</table>';
}
print $q->header;
print <<"END_HTML";
<html>
<head>
<title>Upload form using CGI</title>
</head>
<body>
<h1>Upload form using CGI</h1>
$msg
#{[ $q->start_form() ]}
<p><input type="file" name="myfile" accept="image/gif,image/jpeg,image/png" multiple required /></p>
<p><input type="submit" value="Upload"></p>
#{[ $q->end_form() ]}
</body>
</html>
END_HTML
Before Posting:
After Posting 3 images:
It's possible that you simple have an outdated version of CGI. Check the version
$ perl -MCGI -E 'say $CGI::VERSION'
4.04
A page that prints out a file (on the server) contents and provides a direct download link.
Download File HERE
Start contents of file:
line 1
line 2
line 3
...
I am not sure of the best way and the right header that will allow a download link and HTML text. This prints out blank
print $mycgi->header(
-cookie => $mycookie,
-Type => "application/x-download"
-'Content-Disposition'=>'attachment; filename="FileName"'
);
You can include a link to a script and pass the filename as a parameter. The link might look something like this:
http://url/to/script?action=download&file=foo
Below that, simply print the contents of the file:
#!/usr/bin/perl -T
use strict;
use warnings;
use CGI qw/escapeHTML/;
my $q = CGI->new;
print $q->header,
$q->start_html('foo'),
$q->a({ -href => 'http://url/to/script?action=download&file=foo' }, 'Click to download'),
"<pre>";
open my $fh, "<", "/path/to/file" or die $!;
print escapeHTML($_) while <$fh>;
close $fh;
print "</pre>", $q->end_html;
Note that you should use escapeHTML() to prevent the browser from rendering anything in the file as HTML (which the <pre> tag alone does not take care of).
When the script is called with the action parameter set to download, use the application/x-download content type as you did above:
my $q = CGI->new;
# Untaint parameters
my ($action) = ($q->param('action') =~ /^(\w+)$/g);
my ($file) = ($q->param('file') =~ /^([-.\w]+)$/g);
# Map file parameter to the actual file name on your filesystem.
# The user should never know the actual file name. There are many
# ways you could implement this.
???
if ($action eq "download") {
print $q->header(
-type => "application/x-download",
-'Content-Disposition' => 'attachment; filename="FileName"'
);
open my $fh, "<", $file or die "Failed to open `$file' for reading: $!";
print while <$fh>;
close $fh;
}
Note that you also need to print the contents of the file in the body of the response.
I am unable to print the whole lines as i try and parse the ini file using Config:Ini operation, its the last part where I believed that the array will have the whole line and not only the key, I am surely missing something here
Input
[DomainCredentials]
broker=SERVER
domain=CUSTOMER1
[ProviderCredentials]
Class=A
Routine=B
Code
#!/sbin/perl -w
use lib "/usr/lib/perl5/site_perl";
use lib "/usr/lib/perl5/vendor_perl";
use strict;
use warnings;
use Config::IniFiles;
my $sPPFile="/tmp/config.txt";
my $sysSec="DomainCredentials";
my $cfg = Config::IniFiles->new(-file=> $sPPFile) || die "Could open file $sPPFile\n";
if ($#){
print "Error";
exit 1;
}
my #params_provider = $cfg->Parameters("ProviderCredentials");
foreach (#params_provider){
print $_."\n";
}
Output
Class
Routine
Expected Output
Class=A
Routine=B
You could use the tied hash option of Config::IniFiles to get the config.txt parameter/value pairs:
use strict;
use warnings;
use Config::IniFiles;
my %ini;
my $sPPFile = "/tmp/config.txt";
tie %ini, 'Config::IniFiles', ( -file => $sPPFile );
print "$_=$ini{ProviderCredentials}{$_}\n"
for keys %{ $ini{ProviderCredentials} };
Output on your dataset:
Class=A
Routine=B
You can change the value of a parameter, and then update the config file by doing this:
$ini{ProviderCredentials}{Class} = 'C';
tied(%ini)->RewriteConfig();
The last command actually writes out the entire config held in the tied hash.
Hope this helps!
It looks like Parameters only returns keys.
You then have to use val to get the values.
#!/sbin/perl -w
use lib "/usr/lib/perl5/site_perl";
use lib "/usr/lib/perl5/vendor_perl";
use strict;
use warnings;
use Config::IniFiles;
my $sPPFile="/tmp/config.txt";
my $sysSec="DomainCredentials";
my $cfg = Config::IniFiles->new(-file=> $sPPFile) || die "Could open file $sPPFile\n";
if ($#){
print "Error";
exit 1;
}
my #param_arr = ('broker','domain');
my %param_hash;
foreach my $p (#param_arr){
if (defined $cfg->val("$sysSec",$p)){
$param_hash{$p} = $cfg->val("$sysSec",$p);
}
else{
die "Could not get parameter $p\n";
}
}
#print $param_hash{broker};
#print $param_hash{domain};
my #params_provider = $cfg->Parameters("ProviderCredentials");
if (defined $cfg->Parameters("ProviderCredentials")){
my #params_provider = $cfg->Parameters("ProviderCredentials");
}else{
die "Could not get parameter ProviderCredentials\n";
}
foreach (#params_provider){
print "Key : ".$_."\t Value : ".$cfg->val("ProviderCredentials",$_)."\n";
}
If we set a specified format like this. Is there any way that we can copy the output and put it in a file.
ps: when i use strict, it shows "Global symbol "$counter" requires explicit package name at aggregator.pl line 19". What caused this? I have used local to define its scope, so i got a bit confused. Hope someone can give me a reponse. thx a lot
enter code here
# Setup includes
# use strict;
use XML::RSS;
use LWP::UserAgent;
# Declare variables for URL to be parsed
my $url2parse;
# Get the command-line argument
my $arg = shift;
# Create new instance of XML::RSS
my $rss = new XML::RSS;
# Get the URL, assign it to url2parse, and then parse the RSS content
$url2parse = get($arg);
die "Could not retrieve $arg" unless $url2parse;
$rss->parse($url2parse);
#create arrays to hold data
my #titles;
local $counter = 0;
#open file and write .txt output to it
open my $fh, ">output.txt" or die "File creation failed: $!";
# Print the channel items
foreach my $item (#{$rss->{'items'}}) {
$titles[$counter] = $item->{'title'};
&format_output($item->{'title'});
$counter++;
}
sub get {
my $url = shift;
my $ua = LWP::UserAgent->new();
my $res = $ua->get($url);
die ("Could not retrieve $url: " . $res->status_line) unless($res->is_success);
return $res->content;
}
sub format_output {
local($title) = #_;
$~ = "MYFORMAT";
write;
print $fh #_;
}
format MYFORMAT =
=======================
Title :~ ^<<<<<<<<<
$title
=======================
.
write takes an optional filehandle parameter, so you could replace the print with write $fh. You will need to use 1-parameter select in order to set $~ for your filehandle as well as for STDOUT.
local does not declare the scope of a name, it just saves and restores a value on entry/exit of a scope. Use our or use vars to declare the variable's scope.