Check length per file instead of entire request in CGI Upload - perl

I am attempting to modify the Uber-Uploader perl script so that when an upload is checked if it meets the minimum requirements, it checks per file instead of just the entire request.
I'm not too experienced with perl, and don't know how to do this. Currently the script simply does this:
elsif($ENV{'CONTENT_LENGTH'} > $config{'max_upload_size'}){
my $max_size = &format_bytes($config{'max_upload_size'}, 99);
die("Maximum upload size of $max_size exceeded");
}
All that does is check the content length of the request (which contains multiple files), and fail when the total is greater than the max allowed size.
Is there a way to check it per file?
Note: Changing upload scripts is not an option. Don't try

I'm not sure what you mean by "Changing upload scripts is not an option.", but have you tried something like this?
my $q = CGI->new();
my #files = $q->upload();
foreach my $file (#files){
if ((-s $file) > $config{'max_upload_size'}){
die("Maximum upload size of $file exceeded");
}
}
(NOTE: this is untested code!!!!!)

Related

Uploading large files with WebService::Dropbox

Can someone here give me some example code for using the
WebService::Dropbox module
to upload files bigger than 1GB?
I followed the instructions and successfully uploaded files less than 150MB but I don't understand how to upload larger files.
The
module documentation
says this about the update method
Do not use this to upload a file larger than 150 MB. Instead, create an upload session with upload_session/start.
And this is presumably why you have mentioned 150MB in your question.
The documentation for upload_session has this
Uploads large files by upload_session API
# File Handle
my $content = IO::File->new('./mysql.dump', '<');
my $result = $dropbox->upload_session($path, $content);
my $result = $dropbox->upload_session($path, $content, {
mode => 'add',
autorename => JSON::true,
mute => JSON::false
});
Note that, just like the documentation for upload, those two examples of calling upload_session are alternatives, and you should choose the second only if you have special requirements that require non-default option values
There is also no need to use IO::File to open a file: the standard Perl open call will work fine, and you should add a :raw layer whether you are using IO::File or not, like this
open my $content, '<:raw', './mysql.dump' or die $!
There is also no need for JSON::true and JSON::false: a simple 1 and 0 will do fine
This is pretty much identical to the upload use case, which you say you have working fine. What exactly are you having problems with?

Sending gif by ftp to a server in different folders

I use perl for sending gif to a server. I want to move some gif to a folder called precipitation and other gifs to a folder called wind. Now with the following code (well, it is a part of the code I use) I send them, but there is something wrong in the code, because I find all gif in the same folder, in the first one, precipitation. Any idea?
use BSD::Resource;
use File::Copy;
use Net::FTP;
#ACCIONS send gif to the folder precipitation
$ftp->cwd("html/pen/precipitation");
foreach my $file ($ftp->ls("Pl*.gif")){
$ftp->delete($file) or die "Error in delete\n";
}
my #arxius = glob("/home/gif/Pen/Pl*.gif");
foreach my $File(#arxius){
$ftp->binary();
$ftp->put("$File");
}
#ACCIONS send gif to the folder wind
$ftp->cwd("html/pen/wind");
foreach my $file2 ($ftp->ls("vent*.gif")){
$ftp->delete($file2) or die "Error in delete\n";
}
my #arxius2 = glob("/home/gif/Pen/vent*.gif");
foreach my $File(#arxius2){
$ftp->binary();
$ftp->put("$File");
}
The behavior indicates that the second call to cwd() failed.
Most likely this is because you are using a relative rather than absolute path: the second cwd() call is relative to the location set in the first one. It tries to go to html/pen/precipitation/html/pen/wind which doesn't appear to be what you want.
Use an absolute path or ../wind in the second cwd() call.
Also, you should check for the success of the cwd() commands and stop if you didn't change to the expected directory. Otherwise, you are performing potentially destructive actions (like deleting files) in the wrong place!cwd() will return true if it worked and false otherwise. See the Net::FTP documentation.

Change output filename from WGET when using input file option

I have a perl script that I wrote that gets some image URLs, puts the urls into an input file, and proceeds to run wget with the --input-file option. This works perfectly... or at least it did as long as the image filenames were unique.
I have a new company sending me data and they use a very TROUBLESOME naming scheme. All files have the same name, 0.jpg, in different folders.
for example:
cdn.blah.com/folder/folder/202793000/202793123/0.jpg
cdn.blah.com/folder/folder/198478000/198478725/0.jpg
cdn.blah.com/folder/folder/198594000/198594080/0.jpg
When I run my script with this, wget works fine and downloads all the images, but they are titled 0.jpg.1, 0.jpg.2, 0.jpg.3, etc. I can't just count them and rename them because files can be broken, not available, whatever.
I tried running wget once for each file with -O, but it's embarrassingly slow: starting the program, connecting to the site, downloading, and ending the program. Thousands of times. It's an hour vs minutes.
So, I'm trying to find a method to change the output filenames from wget without it taking so long. The original approach works so well that I don't want to change it too much unless necessary, but i am open to suggestions.
Additional:
LWP::Simple is too simple for this. Yes, it works, but very slowly. It has the same problem as running individual wget commands. Each get() or get_store() call makes the system re-connect to the server. Since the files are so small (60kB on average) with so many to process (1851 for this one test file alone) that the connection time is considerable.
The filename i will be using can be found with /\/(\d+)\/(\d+.jpg)/i where the filename will simply be $1$2 to get 2027931230.jpg. Not really important for this question.
I'm now looking at LWP::UserAgent with LWP::ConnCache, but it times out and/or hangs on my pc. I will need to adjust the timeout and retry values. The inaugural run of the code downloaded 693 images (43mb) in just a couple minutes before it hung. Using simple, I only got 200 images in 5 minutes.
use LWP::UserAgent;
use LWP::ConnCache;
chomp(#filelist = <INPUTFILE>);
my $browser = LWP::UserAgent->new;
$browser->conn_cache(LWP::ConnCache->new());
foreach(#filelist){
/\/(\d+)\/(\d+.jpg)/i
my $newfilename = $1.$2;
$response = $browser->mirror($_, $folder . $newfilename);
die 'response failure' if($response->is_error());
}
LWP::Simple's getstore function allows you to specify a URL to fetch from and the filename to store the data from it in. It's an excellent module for many of the same use cases as wget, but with the benefit of being a Perl module (i.e. no need to outsource to the shell or spawn off child processes).
use LWP::Simple;
# Grab the filename from the end of the URL
my $filename = (split '/', $url)[-1];
# If the file exists, increment its name
while (-e $filename)
{
$filename =~ s{ (\d+)[.]jpg }{ $1+1 . '.jpg' }ex
or die "Unexpected filename encountered";
}
getstore($url, $filename);
The question doesn't specify exactly what kind of renaming scheme you need, but this will work for the examples given by simply incrementing the filename until the current directory doesn't contain that filename.

How to combine zip files with Archive::Zip in Perl

I have two zip files, A.zip and B.zip. I want to add whatever files are in A.zip to B.zip.
How can I do this with Archive::Zip in Perl? I thought I could do something like this:
my $zipA = Archive::Zip->new();
my $zipB = Archive::Zip->new();
die 'read error' unless ($zipA->read( 'A.zip' ) == AZ_OK );
my #members = $zipA->memberNames();
for my $m (#members) {
my $file = $zipA->removeMember($m);
$zipB->addMember($file);
}
but unless I call writeToFileNamed() then no files get created, and if I do call it, B.zip gets overwritten with the contents of A.zip.
I could read in the contents of B.zip, and write them along with the contents of A.zip back to B.zip but this seems really inefficient. (My problem actually involves millions of text files compressed into thousands of zip files.)
Is there a better way to do this?
Using Archive::Zip:
my $zipA = Archive::Zip->new('A.zip');
my $zipB = Archive::Zip->new('B.zip');
foreach ($zipA->members) {
$zipA->removeMember($_);
$zipB->addMember($_);
}
$zipB->overwrite;
The problem is:
You need to add the actual members, not just the memberNames.
You need to read B.zip before you can add to it.
(I'll leave it to you to do error handling etc)
You may try chilkat::CkZip instead of Archive::Zip. Its QuickAppend() method seems to be helpful.

Perl file size limit

I know how to read|write|open files in perl. What am trying to achieve is this; how do I create a new file when the existing file exceeds 'x' size. For instance, I have a 3MB file size, before writing to the same file, check the size, if size exceed 3MB, create a new one, chmod it if needed, then write.
I don't know if my question is clear -
$size = -s '/path/to/file.txt';
if(($size / 1048576) > 3) {
print "too big";
}
else {
do_something();
}
You can use stat for this:
http://perldoc.perl.org/functions/stat.html
stat gives you a lot of information about a given file, including the size.
Example:
use File::stat;
my $filesize = stat("test.txt")->size;
Once you've determined that the file is big enough to rotate using -s, Logfile::Rotate can be used to do the rotation.