Scoop -- the swiss army chainsaw of content management
Front Page Everything News Code Help! Wishlist Project Scoop Sites Dev Notes Latest CVS changes Development Activities
Scoop Box Exchange - Show Box: upload 1.00

Author: sleeper22 [Info]

Description:

Handles file uploads (using new group perms) by first displaying a form and then uploading the file upon submission.

Box Code:

## START upload ##
my ($content);
require File::Path;

######## Config ############
## The number of directory levels, relative to document root,
## beyond which directory creation is not allowed
my $create_dir_limit = 8;

## Specify special keywords
my %location = (IMAGEDIR => $S->{UI}->{VARS}->{imagedir},
);
my $perm_prefix = 'upload_'; # used in perm_groups
######## End Config ########




my $path = $S->{CGI}->param('path');


if ($path and
my $upload = $S->{APR}->upload ) {

$path =~ s/^s+//;
$path =~ s/s+$//;


my ($access);

my ($rv, $sth) = $S->db_select({
FROM => 'vars',
WHAT => 'name, value',
WHERE => "category = 'upload'",
});

if ($rv > 0) {
while ( my($var,$val) = $sth->fetchrow ) {
$location{$var} = $val;
}
}
$sth->finish;

### Assume given path is relative to docroot
$path = "/$path" unless ($path =~ m,^/,);

foreach my $name (keys %location) {
my $loc = $location{$name};
next unless ($loc =~ /\S/ and $loc !~ /\.\./);
next unless ($path =~ /^$loc/);
$S->have_perm("$perm_prefix$name") && ($access = 1) && last;
}

if ($access) { ## permission granted

### Prepare to write file
### Get info about file data
my $filename = $upload->filename;
my $size = $upload->size;
my $docroot = $S->{APACHE}->document_root;
my $abort = 0;


$filename =~ s/^s+//;
$filename =~ s/s+$//;


$path =~ s/ /\ /g; ## escape spaces
$path =~ s/\.\./\./g; ## remove doubledots

## untaint
if ( $path =~ /^([\w\.-\/]+)$/ ) {
$path = $1;
} else {
$content .= qq|<p>Invalid path. Unable to upload file.</p>|;
$path = '';
$abort = 1;
}

## Create the directory for this file
(my $pathdir = "$docroot$path") =~ s,[^/]*$,,;
if (!-e $pathdir) {

if ( $path =~ /(?:\/.*){$create_dir_limit}/ ) {
$content .= qq|<p>Creating directories that many levels deep is not allowed. Choose a new path.</p>|;
$abort = 1;

} else {
eval {
File::Path::mkpath($pathdir, 0, 0755);
}
}
}

if (!$docroot) {
$content .= qq|<p>Server error.</p>|;
warn "No document root found.";

} elsif (-d "$docroot$path") {
### Add original filename to destination path

$filename =~ s/ /\ /g; ## escape spaces
$filename =~ s/\.\./\./g; ## remove doubledots

if ($filename =~ /^([\w\.-]+)$/) {

## untaint name
$filename = $1;

$content .= qq|<p>$path is a directory, so using filename $filename</p>|;
$path .= '/' unless ($path =~ m,/$,);
$path .= $filename;


if (-d "$docroot$path") { ## another directory!
$content .= qq|<p>$path is a directory too. Please include a different filename</p>|;
$abort = 1;
}

} else {
$content .= qq|<p>$path is a directory. Please include a valid filename too.</p>|;
$filename = '';
$abort = 1;
}

} else {

}

if (!-d "$docroot$path" and -e "$docroot$path") {
$content .= qq|<p>$path is being overwritten...</p>|;
}


unless ($abort) {
my $writefile = $docroot . $path;

## Write file
if (open OUT, ">$writefile" ) {
my ($buff,$bytes_read);
my $fh = $upload->fh;

while ($bytes_read = read($fh,$buff,2096)) {
$size += $bytes_read;
binmode OUT;
print OUT $buff;
}

close OUT;
# $content .= qq|<p>File <b>$path ($size bytes)</b> has been written.</p>|;
## $size gets doubles for some reason?
$content .= qq|<p>File <b>$path</b> has been written.</p>|;

} else {
$content .= qq|<p>Unable to write file $writefile... $!</p>|;
}
}

} else {
(my $pathdir = $path) =~ s,[^/]*$,,;
$content .= qq|<p>Access denied to area $pathdir.</p>|;
}

} else {

my $uri = $S->{APACHE}->uri;
$content .= qq|
<FORM name="upload_form" action="$uri" method="POST" enctype="multipart/form-data">
<table>
<tr>
<td>Specify path of local file to upload:</td>
<td><INPUT type="file" name="sourcefile" size="40"/></td>
</tr><tr>
<td>Specify destination path, including file name.</td>
<td><INPUT type="text" name="path" size="40"/></td>
</tr></table>
<INPUT type="submit" value="upload" />
</FORM>
|;
}

return $content;
## END upload ##
Display: Sort:
Problem with Delimiters (none / 0) (#1)
by epoch7 on Sun Aug 28, 2005 at 02:49:25 PM PST

I don't know too much about perl but I had a problem with this modules use of delimeters for qq, so instead of using pipes I changed them to ^'s and now it compiles



Education (none / 0) (#2)
by James Milton on Mon Dec 10, 2018 at 05:12:41 AM PST

In our country so much, back ward people and traditional societies involve. That's why our country not strong in the https://australianwritings.com.au/pay-someone-to-do-your-assignment/ way and also education. Because all think if we learn the education then we forget our traditional education.



lottovip (none / 0) (#3)
by hasnainkhatri on Tue Jan 21, 2020 at 04:14:55 PM PST

Personally, I have found that to remain probably the most fascinating topics when it draws a parallel to. You may find two to three new levels inside L . a . Weight loss and any one someone is incredibly important. Initial stage may be real melting away rrn the body. lose weight lottovip



cbd oil for sale (none / 0) (#4)
by hasnainkhatri on Thu Jan 23, 2020 at 07:34:26 AM PST

I was very impressed by this post, this site has always been pleasant news Thank you very much for such an interesting post, and I meet them more often then I visited this site. cbd oil for sale



Finance Offers (none / 0) (#5)
by hasnainkhatri on Sat Jan 25, 2020 at 07:09:34 AM PST

Particular interviews furnish firsthand message on mart size, industry trends, ontogeny trends, capitalist landscape and outlook, etc. Finance Offers



aliana (none / 0) (#6)
by hasnainkhatri on Sun Jan 26, 2020 at 03:06:20 PM PST

You guardians do an astounding web diary, and have some unfathomable substance. Continue doing extraordinary. แทงหวย



01AG969 Touch LCD Screen Display (none / 0) (#7)
by hasnainkhatri on Mon Jan 27, 2020 at 06:30:42 AM PST

I think this is an informative post and it is very useful and knowledgeable. therefore, I would like to thank you for the efforts you have made in writing this article. 01AG969 Touch LCD Screen Display



payday loan consolidation company (none / 0) (#8)
by hasnainkhatri on Wed Jan 29, 2020 at 12:35:21 AM PST

I truly value this superb post that you have accommodated us. I guarantee this would be helpful for a large portion of the general population. payday loan consolidation company



AllenTiny (none / 0) (#9)
by msmeer on Wed Jan 29, 2020 at 01:00:20 AM PST

This is my first time visit to your blog and I am very interested in the articles that you serve. Provide enough knowledge for me. Thank you for sharing useful and don't forget, keep sharing useful info: แทงหวยออนไลน์



Delta Bpo (none / 0) (#10)
by hasnainkhatri on Wed Jan 29, 2020 at 07:29:54 AM PST

Excellent .. Amazing .. I'll bookmark your blog and take the feeds also...I'm happy to find so many useful info here in the post, we need work out more techniques in this regard, thanks for sharing. Delta Bpo



California Search (none / 0) (#11)
by hasnainkhatri on Mon Feb 03, 2020 at 08:10:03 AM PST

I genuinely believed you would probably have something useful to say. All I hear is a bunch of whining about something that you can fix if you were not too busy looking for attention. After all, I know it was my choice to read.. California Search



AllenTiny (none / 0) (#12)
by msmeer on Thu Feb 06, 2020 at 01:46:55 AM PST

If you are looking for more information about flat rate locksmith Las Vegas check that right away. watch anime online



dash miner asic (none / 0) (#13)
by hasnainkhatri on Fri Feb 07, 2020 at 06:19:42 AM PST

I really loved reading your blog. It was very well authored and easy to undertand. Unlike additional blogs I have read which are really not tht good. I also found your posts very interesting. In fact after reading. I had to go show it to my friend and he ejoyed it as well! dash miner asic



aliana (none / 0) (#14)
by hasnainkhatri on Sat Feb 08, 2020 at 07:22:40 AM PST

I definitely enjoying every little bit of it. It is a great website and nice share. I want to thank you. Good job! You guys do a great blog, and have some great contents. Keep up the good work https://careertipsinfo.com/statistic-problems-that-can-be-solved-using-online-help/



go wikimedia (none / 0) (#15)
by hasnainkhatri on Tue Feb 11, 2020 at 12:16:22 AM PST

Your post is very helpful to get some effective tips to reduce weight properly. You have shared various nice photos of the same. I would like to thank you for sharing these tips. Surely I will try this at home. Keep updating more simple tips like this. go wikimedia



go wikimedia (none / 0) (#16)
by hasnainkhatri on Tue Feb 11, 2020 at 12:16:36 AM PST

Your post is very helpful to get some effective tips to reduce weight properly. You have shared various nice photos of the same. I would like to thank you for sharing these tips. Surely I will try this at home. Keep updating more simple tips like this. go wikimedia



huay.com (none / 0) (#17)
by hasnainkhatri on Sun Feb 23, 2020 at 12:27:54 AM PST

I was impressed with the site that you created, so memotipasi many people to be more advanced, there also kunjugi me, as a comparison huay.com



aliana (none / 0) (#18)
by hasnainkhatri on Wed Mar 04, 2020 at 02:05:02 AM PST

This blog was extremely helpful. I really appreciate your kindness in sharing this with me and everyone else! https://www.smore.com/md8kt-bioharmony-advanced-review-legit



https://www.youtube.com/watch?v=uGbXD_VfSJU (none / 0) (#19)
by hasnainkhatri on Wed Mar 11, 2020 at 03:48:23 AM PST

I am happy to find your distinguished way of writing the post. Now you make it easy for me to understand and implement the concept. Thank you for the post. https://www.youtube.com/watch?v=uGbXD_VfSJU



Cool Directory (none / 0) (#20)
by hasnainkhatri on Fri Mar 13, 2020 at 09:11:02 AM PST

Your work here on this blog has been top notch from day 1. You've been continously providing amazing articles for us all to read and I just hope that you keep it going on in the future as well. Cheers! 먹튀



&#47673;&#53888;&#44160;&#51613; (none / 0) (#21)
by Everett on Tue Mar 17, 2020 at 03:50:44 AM PST

I definitely enjoying every little bit of it. It is a great website and nice share. I want to thank you. Good job! You guys do a great blog, and have some great contents. Keep up the good work. 먹튀검증



Tuinontwerpen (none / 0) (#22)
by lipek on Sat Mar 21, 2020 at 03:59:45 AM PST

Thanks for posting this info. I just want to let you know that I just check out your site and I find it very interesting and informative. I can't wait to read lots of your posts. Tuinontwerpen



Dewabet (none / 0) (#23)
by lipek on Mon Mar 23, 2020 at 08:54:21 AM PST

I've been searching for some decent stuff on the subject and haven't had any luck up until this point, You just got a new biggest fan!.. Dewabet



SOUR DIESEL (none / 0) (#24)
by lipek on Thu Mar 26, 2020 at 03:14:09 AM PST

Positive site, where did u come up with the information on this posting? I'm pleased I discovered it though, ill be checking back soon to find out what additional posts you include. SOUR DIESEL



midwood condo price (none / 0) (#25)
by lipek on Sat Mar 28, 2020 at 07:04:03 AM PST

Thanks for sharing nice information with us. i like your post and all you share with us is uptodate and quite informative, i would like to bookmark the page so i can come here again to read you, as you have done a wonderful job. midwood condo price



Free view installer (none / 0) (#26)
by lipek on Sun Mar 29, 2020 at 09:13:53 AM PST

This is my first time i visit here and I found so many interesting stuff in your blog especially it's discussion, thank you. Free view installer



learn more (none / 0) (#27)
by lipek on Mon Mar 30, 2020 at 09:21:48 AM PST

I wanted to thank you for this excellent read!! I definitely loved every little bit of it. I have you bookmarked your site to check out the new stuff you post. learn more



Menu
create account
faq
search
report bugs
Scoop Administrators Guide
Scoop Box Exchange

Scoop Site Scroller: Get one yourself!
Smokedot
It's 4:19... do you know where your bong is?

Login
Make a new account
Username:
Password:

Hosted by ScoopHost.com Powered by Scoop
All trademarks and copyrights on this page are owned by their respective companies. Comments are owned by the Poster. The Rest 1999 The Management

create account | faq | search