ikiwiki/IkiWiki/Plugin/attachment.pm

507 lines
14 KiB
Perl
Raw Normal View History

#!/usr/bin/perl
package IkiWiki::Plugin::attachment;
use warnings;
use strict;
use IkiWiki 2.00;
2008-07-01 06:42:42 +02:00
sub import { #{{{
hook(type => "getsetup", id => "attachment", call => \&getsetup);
hook(type => "checkconfig", id => "attachment", call => \&checkconfig);
hook(type => "formbuilder_setup", id => "attachment", call => \&formbuilder_setup);
hook(type => "formbuilder", id => "attachment", call => \&formbuilder);
} # }}}
sub getsetup () { #{{{
return
virus_checker => {
type => "string",
example => "clamdscan -",
description => "virus checker program (reads STDIN, returns nonzero if virus found)",
safe => 0, # executed
rebuild => 0,
},
allowed_attachments => {
type => "string",
example => "mimetype(image/*) and maxsize(50kb)",
description => "enhanced PageSpec specifying what attachments are allowed",
description_html => htmllink("", "",
"ikiwiki/PageSpec/attachment",
noimageinline => 1,
linktext => "enhanced PageSpec",
)." specifying what attachments are allowed",
safe => 1,
rebuild => 0,
},
} #}}}
2008-07-24 01:25:46 +02:00
sub check_canattach ($$;$) { #{{{
my $session=shift;
my $dest=shift; # where it's going to be put, under the srcdir
my $file=shift; # the path to the attachment currently
# Don't allow an attachment to be uploaded with the same name as an
# existing page.
if (exists $pagesources{$dest} && $pagesources{$dest} ne $dest) {
error(sprintf(gettext("there is already a page named %s"), $dest));
}
# Use a special pagespec to test that the attachment is valid.
my $allowed=1;
if (defined $config{allowed_attachments} &&
length $config{allowed_attachments}) {
$allowed=pagespec_match($dest,
$config{allowed_attachments},
file => $file,
user => $session->param("name"),
ip => $ENV{REMOTE_ADDR},
);
}
# XXX deprecated, should be removed eventually
if ($allowed) {
foreach my $admin (@{$config{adminuser}}) {
my $allowed_attachments=IkiWiki::userinfo_get($admin, "allowed_attachments");
if (defined $allowed_attachments &&
length $allowed_attachments) {
$allowed=pagespec_match($dest,
$allowed_attachments,
file => $file,
user => $session->param("name"),
ip => $ENV{REMOTE_ADDR},
);
last if $allowed;
}
}
}
if (! $allowed) {
2008-07-22 21:06:59 +02:00
error(gettext("prohibited by allowed_attachments")." ($allowed)");
}
else {
return 1;
}
2008-07-24 01:25:46 +02:00
} #}}}
sub checkconfig () { #{{{
$config{cgi_disable_uploads}=0;
} #}}}
sub formbuilder_setup (@) { #{{{
my %params=@_;
my $form=$params{form};
my $q=$params{cgi};
2008-07-06 23:35:50 +02:00
if (defined $form->field("do") && $form->field("do") eq "edit") {
# Add attachment field, set type to multipart.
$form->enctype(&CGI::MULTIPART);
$form->field(name => 'attachment', type => 'file');
2008-07-01 23:19:38 +02:00
# These buttons are not put in the usual place, so
2008-07-02 02:35:54 +02:00
# are not added to the normal formbuilder button list.
2008-07-01 23:19:38 +02:00
$form->tmpl_param("field-upload" => '<input name="_submit" type="submit" value="Upload Attachment" />');
$form->tmpl_param("field-link" => '<input name="_submit" type="submit" value="Insert Links" />');
# Add the javascript from the toggle plugin;
# the attachments interface uses it to toggle visibility.
require IkiWiki::Plugin::toggle;
$form->tmpl_param("javascript" => $IkiWiki::Plugin::toggle::javascript);
# Start with the attachments interface toggled invisible,
# but if it was used, keep it open.
if ($form->submitted ne "Upload Attachment" &&
(! defined $q->param("attachment_select") ||
! length $q->param("attachment_select"))) {
$form->tmpl_param("attachments-class" => "toggleable");
}
else {
$form->tmpl_param("attachments-class" => "toggleable-open");
}
}
elsif ($form->title eq "preferences") {
# XXX deprecated, should remove eventually
my $session=$params{session};
my $user_name=$session->param("name");
$form->field(name => "allowed_attachments", size => 50,
fieldset => "admin",
comment => "deprecated; please move to allowed_attachments in setup file",
2008-07-03 00:07:34 +02:00
);
if (! IkiWiki::is_admin($user_name)) {
$form->field(name => "allowed_attachments", type => "hidden");
}
if (! $form->submitted) {
my $value=IkiWiki::userinfo_get($user_name, "allowed_attachments");
if (length $value) {
$form->field(name => "allowed_attachments", force => 1,
value => IkiWiki::userinfo_get($user_name, "allowed_attachments"));
}
else {
$form->field(name => "allowed_attachments", type => "hidden");
}
}
if ($form->submitted && $form->submitted eq 'Save Preferences') {
if (defined $form->field("allowed_attachments")) {
IkiWiki::userinfo_set($user_name, "allowed_attachments",
$form->field("allowed_attachments")) ||
error("failed to set allowed_attachments");
}
}
}
} #}}}
sub formbuilder (@) { #{{{
my %params=@_;
my $form=$params{form};
2008-07-02 00:08:31 +02:00
my $q=$params{cgi};
2008-07-06 23:35:50 +02:00
return if ! defined $form->field("do") || $form->field("do") ne "edit";
2008-07-02 01:05:15 +02:00
my $filename=$q->param('attachment');
if (defined $filename && length $filename &&
($form->submitted eq "Upload Attachment" || $form->submitted eq "Save Page")) {
2008-07-01 21:35:01 +02:00
my $session=$params{session};
# This is an (apparently undocumented) way to get the name
# of the temp file that CGI writes the upload to.
my $tempfile=$q->tmpFileName($filename);
2008-07-08 22:21:01 +02:00
if (! defined $tempfile || ! length $tempfile) {
attachment: Support perl 5.8's buggy version of CGI.pm. This is truely horribly disgusting. CGI::tmpFileName, in current perls, is an undocumented function (which should be a clue..) that takes the original filename of an uploaded attachment, and returns the name of the tempfile that CGI has stored it in. In old perls, though, CGI::tmpFileName does not take a filename. It takes a key from the object's {'.tmpfiles'} hash. This key is something crazy like '*Fh::fh00001group' -- apparently the stringification of a filehandle object. Just to add to the fun, tmpFileName doesn't take the key, it expects a refernce to the key. Argh?! But the fun doesn't stop there, because in perl 5.8, CGI.pm is also broken in two other ways. The upload() method is supposed to return a filehandle to the temp file. It doesn't. The param() method is supposed to return a filehandle to the temp file, that stringifies to the original filename. It returns just the original filename, no filehandle. Combine all these bugs, and you end up with this disgusting commit. Since I have no way to get the filehandle, I *need* to get the tempfile name. If I had the filehandle, I could probably pass it into tmpFileName, and it might strigify to the right key name. But I don't, so the only way to determine the key is to grub through the .tmpfiles hash ourselves. And finally, one the temp file name is discovered, a filehandle can finally be obtained by (re)opening it. I recommend that this commit be reverted when perl 5.8 is a mercifully faded memory. I'm really, really, really glad I'm actually being paid for working on this right now!
2008-07-09 00:10:05 +02:00
# perl 5.8 needs an alternative, awful method
if ($q =~ /HASH/ && exists $q->{'.tmpfiles'}) {
foreach my $key (keys(%{$q->{'.tmpfiles'}})) {
$tempfile=$q->tmpFileName(\$key);
last if defined $tempfile && length $tempfile;
}
}
if (! defined $tempfile || ! length $tempfile) {
error("CGI::tmpFileName failed to return the uploaded file name");
}
}
$filename=IkiWiki::linkpage(
2008-07-01 23:19:38 +02:00
IkiWiki::possibly_foolish_untaint(
attachment_location($form->field('page')).
IkiWiki::basename($filename)));
if (IkiWiki::file_pruned($filename, $config{srcdir})) {
error(gettext("bad attachment filename"));
}
2008-07-01 05:17:01 +02:00
# Check that the user is allowed to edit a page with the
# name of the attachment.
2008-07-01 21:35:01 +02:00
IkiWiki::check_canedit($filename, $q, $session, 1);
# And that the attachment itself is acceptable.
check_canattach($session, $filename, $tempfile);
2008-07-01 06:42:42 +02:00
2008-07-01 21:35:01 +02:00
# Needed for fast_file_copy and for rendering below.
2008-07-01 19:48:07 +02:00
require IkiWiki::Render;
2008-07-01 06:42:42 +02:00
# Move the attachment into place.
# Try to use a fast rename; fall back to copying.
2008-07-01 19:39:02 +02:00
IkiWiki::prep_writefile($filename, $config{srcdir});
2008-07-01 06:42:42 +02:00
unlink($config{srcdir}."/".$filename);
2008-07-02 01:05:15 +02:00
if (rename($tempfile, $config{srcdir}."/".$filename)) {
# The temp file has tight permissions; loosen up.
chmod(0666 & ~umask, $config{srcdir}."/".$filename);
}
else {
2008-07-01 06:42:42 +02:00
my $fh=$q->upload('attachment');
if (! defined $fh || ! ref $fh) {
# needed by old CGI versions
$fh=$q->param('attachment');
if (! defined $fh || ! ref $fh) {
# even that doesn't always work,
# fall back to opening the tempfile
2008-07-08 18:16:36 +02:00
$fh=undef;
attachment: Support perl 5.8's buggy version of CGI.pm. This is truely horribly disgusting. CGI::tmpFileName, in current perls, is an undocumented function (which should be a clue..) that takes the original filename of an uploaded attachment, and returns the name of the tempfile that CGI has stored it in. In old perls, though, CGI::tmpFileName does not take a filename. It takes a key from the object's {'.tmpfiles'} hash. This key is something crazy like '*Fh::fh00001group' -- apparently the stringification of a filehandle object. Just to add to the fun, tmpFileName doesn't take the key, it expects a refernce to the key. Argh?! But the fun doesn't stop there, because in perl 5.8, CGI.pm is also broken in two other ways. The upload() method is supposed to return a filehandle to the temp file. It doesn't. The param() method is supposed to return a filehandle to the temp file, that stringifies to the original filename. It returns just the original filename, no filehandle. Combine all these bugs, and you end up with this disgusting commit. Since I have no way to get the filehandle, I *need* to get the tempfile name. If I had the filehandle, I could probably pass it into tmpFileName, and it might strigify to the right key name. But I don't, so the only way to determine the key is to grub through the .tmpfiles hash ourselves. And finally, one the temp file name is discovered, a filehandle can finally be obtained by (re)opening it. I recommend that this commit be reverted when perl 5.8 is a mercifully faded memory. I'm really, really, really glad I'm actually being paid for working on this right now!
2008-07-09 00:10:05 +02:00
open($fh, "<", $tempfile) || error("failed to open \"$tempfile\": $!");
}
2008-07-01 06:42:42 +02:00
}
binmode($fh);
writefile($filename, $config{srcdir}, undef, 1, sub {
IkiWiki::fast_file_copy($tempfile, $filename, $fh, @_);
});
}
2008-07-01 06:42:42 +02:00
2008-07-01 21:35:01 +02:00
# Check the attachment in and trigger a wiki refresh.
if ($config{rcs}) {
IkiWiki::rcs_add($filename);
IkiWiki::disable_commit_hook();
IkiWiki::rcs_commit($filename, gettext("attachment upload"),
IkiWiki::rcs_prepedit($filename),
$session->param("name"), $ENV{REMOTE_ADDR});
IkiWiki::enable_commit_hook();
IkiWiki::rcs_update();
}
IkiWiki::refresh();
IkiWiki::saveindex();
}
2008-07-02 00:08:31 +02:00
elsif ($form->submitted eq "Insert Links") {
my $page=quotemeta($q->param("page"));
2008-07-02 00:08:31 +02:00
my $add="";
foreach my $f ($q->param("attachment_select")) {
$f=~s/^$page\///;
2008-07-02 00:08:31 +02:00
$add.="[[$f]]\n";
}
$form->field(name => 'editcontent',
value => $form->field('editcontent')."\n\n".$add,
force => 1) if length $add;
2008-07-02 00:08:31 +02:00
}
2008-07-02 01:05:15 +02:00
# Generate the attachment list only after having added any new
# attachments.
$form->tmpl_param("attachment_list" => [attachment_list($form->field('page'))]);
} # }}}
2008-07-24 01:25:46 +02:00
sub attachment_location ($) { #{{{
2008-07-02 01:05:15 +02:00
my $page=shift;
# Put the attachment in a subdir of the page it's attached
# to, unless that page is an "index" page.
$page=~s/(^|\/)index//;
$page.="/" if length $page;
return $page;
2008-07-24 01:25:46 +02:00
} #}}}
2008-07-02 01:05:15 +02:00
2008-07-24 01:25:46 +02:00
sub attachment_list ($) { #{{{
2008-07-02 01:05:15 +02:00
my $page=shift;
my $loc=attachment_location($page);
my @ret;
foreach my $f (values %pagesources) {
if (! defined IkiWiki::pagetype($f) &&
$f=~m/^\Q$loc\E[^\/]+$/ &&
-e "$config{srcdir}/$f") {
push @ret, {
2008-07-02 22:08:48 +02:00
"field-select" => '<input type="checkbox" name="attachment_select" value="'.$f.'" />',
2008-07-02 01:05:15 +02:00
link => htmllink($page, $page, $f, noimageinline => 1),
size => humansize((stat(_))[7]),
mtime => displaytime($IkiWiki::pagemtime{$f}),
mtime_raw => $IkiWiki::pagemtime{$f},
};
}
}
# Sort newer attachments to the top of the list, so a newly-added
# attachment appears just before the form used to add it.
return sort { $b->{mtime_raw} <=> $a->{mtime_raw} || $a->{link} cmp $b->{link} } @ret;
2008-07-24 01:25:46 +02:00
} #}}}
2008-07-02 01:05:15 +02:00
2008-07-24 01:25:46 +02:00
my %units=( #{{{ # size in bytes
2008-07-02 00:40:42 +02:00
B => 1,
byte => 1,
KB => 2 ** 10,
kilobyte => 2 ** 10,
K => 2 ** 10,
KB => 2 ** 10,
kilobyte => 2 ** 10,
M => 2 ** 20,
MB => 2 ** 20,
megabyte => 2 ** 20,
G => 2 ** 30,
GB => 2 ** 30,
gigabyte => 2 ** 30,
T => 2 ** 40,
TB => 2 ** 40,
terabyte => 2 ** 40,
P => 2 ** 50,
PB => 2 ** 50,
petabyte => 2 ** 50,
E => 2 ** 60,
EB => 2 ** 60,
exabyte => 2 ** 60,
Z => 2 ** 70,
ZB => 2 ** 70,
zettabyte => 2 ** 70,
Y => 2 ** 80,
YB => 2 ** 80,
yottabyte => 2 ** 80,
# ikiwiki, if you find you need larger data quantities, either modify
# yourself to add them, or travel back in time to 2008 and kill me.
# -- Joey
2008-07-24 01:25:46 +02:00
); #}}}
sub parsesize ($) { #{{{
my $size=shift;
2008-07-02 00:40:42 +02:00
no warnings;
my $base=$size+0; # force to number
use warnings;
2008-07-02 00:40:42 +02:00
foreach my $unit (sort keys %units) {
2008-07-02 02:35:54 +02:00
if ($size=~/[0-9\s]\Q$unit\E$/i) {
2008-07-02 00:40:42 +02:00
return $base * $units{$unit};
}
}
2008-07-02 00:40:42 +02:00
return $base;
} #}}}
sub humansize ($) { #{{{
my $size=shift;
foreach my $unit (reverse sort { $units{$a} <=> $units{$b} || $b cmp $a } keys %units) {
if ($size / $units{$unit} > 0.25) {
2008-07-02 02:35:54 +02:00
return (int($size / $units{$unit} * 10)/10).$unit;
2008-07-02 00:40:42 +02:00
}
}
2008-07-02 00:40:42 +02:00
return $size; # near zero, or negative
} #}}}
2008-07-02 00:40:42 +02:00
package IkiWiki::PageSpec;
sub match_maxsize ($$;@) { #{{{
shift;
2008-07-02 00:40:42 +02:00
my $maxsize=eval{IkiWiki::Plugin::attachment::parsesize(shift)};
if ($@) {
return IkiWiki::FailReason->new("unable to parse maxsize (or number too large)");
}
my %params=@_;
2008-07-01 05:17:01 +02:00
if (! exists $params{file}) {
2008-07-01 05:32:08 +02:00
return IkiWiki::FailReason->new("no file specified");
}
2008-07-01 05:17:01 +02:00
if (-s $params{file} > $maxsize) {
2008-07-02 01:05:15 +02:00
return IkiWiki::FailReason->new("file too large (".(-s $params{file})." > $maxsize)");
}
else {
2008-07-01 05:17:01 +02:00
return IkiWiki::SuccessReason->new("file not too large");
}
} #}}}
sub match_minsize ($$;@) { #{{{
shift;
2008-07-02 00:40:42 +02:00
my $minsize=eval{IkiWiki::Plugin::attachment::parsesize(shift)};
if ($@) {
return IkiWiki::FailReason->new("unable to parse minsize (or number too large)");
}
my %params=@_;
2008-07-01 05:17:01 +02:00
if (! exists $params{file}) {
2008-07-01 05:32:08 +02:00
return IkiWiki::FailReason->new("no file specified");
}
2008-07-01 05:17:01 +02:00
if (-s $params{file} < $minsize) {
return IkiWiki::FailReason->new("file too small");
}
else {
return IkiWiki::SuccessReason->new("file not too small");
}
} #}}}
2008-07-02 23:30:00 +02:00
sub match_mimetype ($$;@) { #{{{
shift;
my $wanted=shift;
my %params=@_;
if (! exists $params{file}) {
return IkiWiki::FailReason->new("no file specified");
}
# Use ::magic to get the mime type, the idea is to only trust
# data obtained by examining the actual file contents.
eval q{use File::MimeInfo::Magic};
if ($@) {
return IkiWiki::FailReason->new("failed to load File::MimeInfo::Magic ($@); cannot check MIME type");
}
my $mimetype=File::MimeInfo::Magic::magic($params{file});
if (! defined $mimetype) {
$mimetype="unknown";
}
2008-07-02 23:33:37 +02:00
my $regexp=IkiWiki::glob2re($wanted);
2008-07-02 23:30:00 +02:00
if ($mimetype!~/^$regexp$/i) {
return IkiWiki::FailReason->new("file MIME type is $mimetype, not $wanted");
}
else {
return IkiWiki::SuccessReason->new("file MIME type is $mimetype");
}
} #}}}
sub match_virusfree ($$;@) { #{{{
shift;
my $wanted=shift;
my %params=@_;
if (! exists $params{file}) {
return IkiWiki::FailReason->new("no file specified");
}
if (! exists $IkiWiki::config{virus_checker} ||
! length $IkiWiki::config{virus_checker}) {
return IkiWiki::FailReason->new("no virus_checker configured");
}
# The file needs to be fed into the virus checker on stdin,
# because the file is not world-readable, and if clamdscan is
# used, clamd would fail to read it.
eval q{use IPC::Open2};
error($@) if $@;
open (IN, "<", $params{file}) || return IkiWiki::FailReason->new("failed to read file");
binmode(IN);
my $sigpipe=0;
$SIG{PIPE} = sub { $sigpipe=1 };
my $pid=open2(\*CHECKER_OUT, "<&IN", $IkiWiki::config{virus_checker});
my $reason=<CHECKER_OUT>;
chomp $reason;
1 while (<CHECKER_OUT>);
close(CHECKER_OUT);
waitpid $pid, 0;
$SIG{PIPE}="DEFAULT";
if ($sigpipe || $?) {
if (! length $reason) {
$reason="virus checker $IkiWiki::config{virus_checker}; failed with no output";
}
return IkiWiki::FailReason->new("file seems to contain a virus ($reason)");
}
else {
return IkiWiki::SuccessReason->new("file seems virusfree ($reason)");
}
} #}}}
2008-07-01 05:17:01 +02:00
sub match_ispage ($$;@) { #{{{
my $filename=shift;
2008-07-01 06:43:19 +02:00
if (defined IkiWiki::pagetype($filename)) {
2008-07-01 05:17:01 +02:00
return IkiWiki::SuccessReason->new("file is a wiki page");
}
else {
2008-07-01 05:17:01 +02:00
return IkiWiki::FailReason->new("file is not a wiki page");
}
} #}}}
sub match_user ($$;@) { #{{{
shift;
my $user=shift;
my %params=@_;
if (! exists $params{user}) {
return IkiWiki::FailReason->new("no user specified");
}
if (defined $params{user} && lc $params{user} eq lc $user) {
return IkiWiki::SuccessReason->new("user is $user");
}
2008-07-22 19:23:11 +02:00
elsif (! defined $params{user}) {
return IkiWiki::FailReason->new("not logged in");
}
else {
return IkiWiki::FailReason->new("user is $params{user}, not $user");
}
} #}}}
sub match_ip ($$;@) { #{{{
shift;
my $ip=shift;
my %params=@_;
if (! exists $params{ip}) {
return IkiWiki::FailReason->new("no IP specified");
}
if (defined $params{ip} && lc $params{ip} eq lc $ip) {
return IkiWiki::SuccessReason->new("IP is $ip");
}
else {
return IkiWiki::FailReason->new("IP is $params{ip}, not $ip");
}
} #}}}
1