site/cgi-bin/modules/BSE/CfgInfo.pm
site/cgi-bin/modules/BSE/ChangePW.pm
site/cgi-bin/modules/BSE/ComposeMail.pm
+site/cgi-bin/modules/BSE/Util/ContentType.pm
site/cgi-bin/modules/BSE/Custom.pm
site/cgi-bin/modules/BSE/CustomBase.pm
site/cgi-bin/modules/BSE/DB.pm
site/cgi-bin/modules/BSE/Session.pm
site/cgi-bin/modules/BSE/Shop/Util.pm
site/cgi-bin/modules/BSE/Sort.pm
+site/cgi-bin/modules/BSE/Storage/AmazonS3.pm
+site/cgi-bin/modules/BSE/Storage/Base.pm
+site/cgi-bin/modules/BSE/Storage/LocalBase.pm
+site/cgi-bin/modules/BSE/Storage/LocalFiles.pm
+site/cgi-bin/modules/BSE/Storage/LocalImages.pm
+site/cgi-bin/modules/BSE/Storage/FTP.pm
+site/cgi-bin/modules/BSE/StorageMgr/Base.pm
+site/cgi-bin/modules/BSE/StorageMgr/Files.pm
+site/cgi-bin/modules/BSE/StorageMgr/Images.pm
site/cgi-bin/modules/BSE/SubscribedUser.pm
site/cgi-bin/modules/BSE/SubscribedUsers.pm
site/cgi-bin/modules/BSE/SubscriptionType.pm
site/docs/shop.html
site/docs/siteusers.html
site/docs/siteusers.pod
+site/docs/shopadmin.html
site/docs/standard.html
site/docs/standard.pod
-site/docs/shopadmin.html
+site/docs/storages.html
+site/docs/storages.pod
site/docs/templates.html
site/docs/templates.pod
site/docs/thumbnails.html
site/templates/user/userpage_base.tmpl
site/templates/xbase.tmpl
site/util/bseaddimages.pl
+site/util/bse_s3.pl
+site/util/bse_storage.pl
site/util/gen.pl
site/util/getpcode.pl Example code
site/util/initial.pl
url varchar(255),
displayOrder integer not null default 0,
name varchar(255) default '' not null,
+ storage varchar(20) not null default 'local',
+ src varchar(255) not null default '',
PRIMARY KEY (id)
);
hide_from_list integer not null default 0,
+ storage varchar(20) not null default 'local',
+ src varchar(255) not null default '',
+
primary key (id)
);
#!/usr/bin/perl -w
# -d:ptkdb
-BEGIN { $ENV{DISPLAY} = '192.168.32.245:0.0' }
+BEGIN { $ENV{DISPLAY} = '192.168.32.51:0.0' }
use strict;
use FindBin;
use lib "$FindBin::Bin/../modules";
#!/usr/bin/perl -w
# -d:ptkdb
-BEGIN { $ENV{DISPLAY} = '192.168.32.15:0.0'; }
+BEGIN { $ENV{DISPLAY} = '192.168.32.51:0.0'; }
use strict;
use FindBin;
sub columns {
return qw/id articleId displayName filename sizeInBytes description
contentType displayOrder forSale download whenUploaded
- requireUser notes name hide_from_list/;
+ requireUser notes name hide_from_list storage src/;
}
sub remove {
$self->SUPER::remove();
}
+sub article {
+ my $self = shift;
+ require Articles;
+
+ return Articles->getByPkey($self->{articleId});
+}
+
1;
return 'ArticleFile';
}
+sub file_storages {
+ my $self = shift;
+ return map [ $_->{filename}, $_->{storage}, $_ ], $self->all;
+}
+
1;
Images => 'select * from image',
replaceImage =>
- 'replace image values (?,?,?,?,?,?,?,?,?)',
- addImage => 'insert image values(null, ?, ?, ?, ?, ?, ?, ?, ?)',
+ 'replace image values (?,?,?,?,?,?,?,?,?,?,?)',
+ addImage => 'insert image values(null, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)',
deleteImage => 'delete from image where id = ?',
getImageByArticleId => 'select * from image where articleId = ? order by displayOrder',
getImageByPkey => 'select * from image where id = ?',
'OtherParents.anylinks' =>
'select * from other_parents where childId = ? or parentId = ?',
+ ArticleFiles => 'select * from article_files',
addArticleFile =>
- 'insert into article_files values (null,?,?,?,?,?,?,?,?,?,?,?,?,?,?)',
+ 'insert into article_files values (null,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)',
replaceArticleFile =>
- 'replace article_files values (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)',
+ 'replace article_files values (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)',
deleteArticleFile => 'delete from article_files where id = ?',
getArticleFileByArticleId =>
'select * from article_files where articleId = ? order by displayOrder desc',
use BSE::CfgInfo qw(custom_class admin_base_url cfg_image_dir);
use BSE::Util::Iterate;
use BSE::Template;
+use BSE::Util::ContentType qw(content_type);
use constant MAX_FILE_DISPLAYNAME_LENGTH => 255;
sub not_logged_on {
my $cgi = $request->cgi;
my $show_full = $cgi->param('f_showfull');
$msg ||= join "\n", map escape_html($_), $cgi->param('message'), $cgi->param('m');
- $msg ||= '';
- $errors ||= {};
- if (keys %$errors && !$msg) {
- # try to get the errors in the same order as the table
- my @cols = $self->table_object($articles)->rowClass->columns;
- my %work = %$errors;
- my @out = grep defined, delete @work{@cols};
-
- $msg = join "<br>", @out, values %work;
- }
+ $msg ||= $request->message($errors);
my $parent;
if ($article->{id}) {
if ($article->{parentid} > 0) {
$it->make_iterator([ \&iter_groups, $request ],
'group', 'groups', \@groups, undef, undef,
\$current_group),
+ $it->make_iterator([ iter_image_stores => $self],
+ 'image_store', 'image_stores'),
+ $it->make_iterator([ iter_file_stores => $self],
+ 'file_store', 'file_stores'),
ifGroupRequired => [ \&tag_ifGroupRequired, $article, \$current_group ],
);
}
+sub iter_image_stores {
+ my ($self) = @_;
+
+ my $mgr = $self->_image_manager;
+
+ return map +{ name => $_->name, description => $_->description },
+ $mgr->all_stores;
+}
+
+sub _file_manager {
+ my ($self) = @_;
+
+ require BSE::StorageMgr::Files;
+
+ return BSE::StorageMgr::Files->new(cfg => $self->cfg);
+}
+
+sub iter_file_stores {
+ my ($self) = @_;
+
+ my $mgr = $self->_file_manager;
+
+ return map +{ name => $_->name, description => $_->description },
+ $mgr->all_stores;
+}
+
sub iter_groups {
my ($req) = @_;
my %changes;
my %errors;
my %names;
- my @old_images;
+ my %old_images;
my @new_images;
for my $image (@images) {
my $id = $image->{id};
require Image::Size;
my ($width, $height, $type) = Image::Size::imgsize($full_filename);
if ($width) {
- push @old_images, $image->{image};
+ $old_images{$id} =
+ {
+ image => $image->{image},
+ storage => $image->{storage}
+ };
push @new_images, $image_name;
$changes{$id}{image} = $image_name;
+ $changes{$id}{storage} = 'local';
+ $changes{$id}{src} = "/images/$image_name";
$changes{$id}{width} = $width;
$changes{$id}{height} = $height;
}
return $self->edit_form($req, $article, $articles, undef,
\%errors);
}
- if (keys %changes) {
- for my $image (@images) {
- my $id = $image->{id};
- $changes{$id}
- or next;
- for my $field (keys %{$changes{$id}}) {
- $image->{$field} = $changes{$id}{$field};
+ my $mgr = $self->_image_manager($req->cfg);
+ $req->flash('Image information saved');
+ my $changes_found = 0;
+ my $auto_store = $cgi->param('auto_storage');
+ for my $image (@images) {
+ my $id = $image->{id};
+
+ if ($changes{$id}) {
+ my $changes = $changes{$id};
+ ++$changes_found;
+
+ for my $field (keys %$changes) {
+ $image->{$field} = $changes->{$field};
}
$image->save;
}
- # delete any image files that were replaced
- unlink map "$image_dir/$_", @old_images;
-
+ my $old_storage = $image->{storage};
+ my $new_storage = $auto_store ? '' : $cgi->param("storage$id");
+ defined $new_storage or $new_storage = $image->{storage};
+ $new_storage = $mgr->select_store($image->{image}, $new_storage, $image);
+ if ($new_storage ne $old_storage) {
+ eval {
+ $image->{src} = $mgr->store($image->{image}, $new_storage, $image);
+ $image->{storage} = $new_storage;
+ $image->save;
+ };
+
+ if ($old_storage ne 'local') {
+ $mgr->unstore($image->{image}, $old_storage);
+ }
+ }
+ }
+
+ # delete any image files that were replaced
+ for my $old_image (values %old_images) {
+ my ($image, $storage) = @$old_image{qw/image storage/};
+ if ($storage ne 'local') {
+ $mgr->unstore($image->{image}, $storage);
+ }
+ unlink "$image_dir/$image";
+ }
+
+ if ($changes_found) {
use Util 'generate_article';
generate_article($articles, $article) if $Constants::AUTO_GENERATE;
}
-
- return $self->refresh($article, $cgi, undef, 'Image information saved');
+
+ return $self->refresh($article, $cgi);
}
sub _service_error {
url => $url,
displayOrder=>time,
name => $imageref,
+ storage => 'local',
+ src => '/images/' . $filename,
);
require Images;
my @cols = Image->columns;
shift @cols;
my $imageobj = Images->add(@image{@cols});
+ my $storage = $cgi->param('storage');
+ defined $storage or $storage = 'local';
+ my $image_manager = $self->_image_manager($req->cfg);
+ local $SIG{__DIE__};
+ eval {
+ my $src;
+ $storage = $image_manager->select_store($filename, $storage, $imageobj);
+ $src = $image_manager->store($filename, $storage, $imageobj);
+
+ if ($src) {
+ $imageobj->{src} = $src;
+ $imageobj->{storage} = $storage;
+ $imageobj->save;
+ }
+ };
+ if ($@) {
+ $req->flash($@);
+ }
+
use Util 'generate_article';
generate_article($articles, $article) if $Constants::AUTO_GENERATE;
}
}
+sub _image_manager {
+ my ($self) = @_;
+
+ require BSE::StorageMgr::Images;
+
+ return BSE::StorageMgr::Images->new(cfg => $self->cfg);
+}
+
# remove an image
sub remove_img {
my ($self, $req, $article, $articles, $imageid) = @_;
my @images = $self->get_images($article);
my ($image) = grep $_->{id} == $imageid, @images
or return $self->show_images($req, $article, $articles, "No such image");
+
+ if ($image->{storage} ne 'local') {
+ my $mgr = $self->_image_manager($req->cfg);
+ $mgr->unstore($image->{image}, $image->{storage});
+ }
+
my $imagedir = cfg_image_dir($req->cfg);
unlink "$imagedir$image->{image}";
$image->remove;
my $image_dir = cfg_image_dir($req->cfg);
+ my $old_storage = $image->{storage};
+
my %errors;
my $delete_file;
my $alt = $cgi->param('alt');
$image->{image} = $image_name;
$image->{width} = $width;
$image->{height} = $height;
+ $image->{storage} = 'local'; # not on the remote store yet
+ $image->{src} = '/images/' . $image_name;
}
else {
$errors{image} = $type;
keys %errors
and return $self->req_edit_image($req, $article, $articles, \%errors);
+ my $new_storage = $cgi->param('storage');
+ defined $new_storage or $new_storage = $image->{storage};
$image->save;
- unlink "$image_dir/$delete_file"
- if $delete_file;
+ my $mgr = $self->_image_manager($req->cfg);
+ if ($delete_file) {
+ if ($old_storage ne 'local') {
+ $mgr->unstore($delete_file, $old_storage);
+ }
+ unlink "$image_dir/$delete_file";
+ }
+ $req->flash("Image saved");
+ eval {
+ $new_storage =
+ $mgr->select_store($image->{image}, $new_storage);
+ if ($image->{storage} ne $new_storage) {
+ # handles both new images (which sets storage to local) and changing
+ # the storage for old images
+ my $old_storage = $image->{storage};
+ my $src = $mgr->store($image->{image}, $new_storage, $image);
+ $image->{src} = $src;
+ $image->{storage} = $new_storage;
+ $image->save;
+ }
+ };
+ $@ and $req->flash("There was a problem adding it to the new storage: $@");
+ if ($image->{storage} ne $old_storage && $old_storage ne 'local') {
+ eval {
+ $mgr->unstore($image->{image}, $old_storage);
+ };
+ $@ and $req->flash("There was a problem removing if from the old storage: $@");
+ }
- return $self->refresh($article, $cgi, undef, 'Image saved');
+ return $self->refresh($article, $cgi);
}
sub get_article {
$articles;
}
-my %types =
- (
- qw(
- bash text/plain
- css text/css
- csv text/plain
- diff text/plain
- htm text/html
- html text/html
- ics text/calendar
- patch text/plain
- pl text/plain
- pm text/plain
- pod text/plain
- py text/plain
- sgm text/sgml
- sgml text/sgml
- sh text/plain
- tcsh text/plain
- text text/plain
- tsv text/tab-separated-values
- txt text/plain
- vcf text/x-vcard
- vcs text/x-vcalendar
- xml text/xml
- zsh text/plain
- bmp image/bmp
- gif image/gif
- jp2 image/jpeg2000
- jpeg image/jpeg
- jpg image/jpeg
- pct image/pict
- pict image/pict
- png image/png
- tif image/tiff
- tiff image/tiff
- dcr application/x-director
- dir application/x-director
- doc application/msword
- dxr application/x-director
- eps application/postscript
- fla application/x-shockwave-flash
- flv application/x-shockwave-flash
- gz application/gzip
- hqx application/mac-binhex40
- js application/x-javascript
- lzh application/x-lzh
- pdf application/pdf
- pps application/ms-powerpoint
- ppt application/ms-powerpoint
- ps application/postscript
- rtf application/rtf
- sit application/x-stuffit
- swf application/x-shockwave-flash
- tar application/x-tar
- tgz application/gzip
- xls application/ms-excel
- Z application/x-compress
- zip application/zip
- asf video/x-ms-asf
- avi video/avi
- flc video/flc
- moov video/quicktime
- mov video/quicktime
- mp4 video/mp4
- mpeg video/mpeg
- mpg video/mpeg
- wmv video/x-ms-wmv
- 3gp video/3gpp
- aa audio/audible
- aif audio/aiff
- aiff audio/aiff
- m4a audio/m4a
- mid audio/midi
- mp2 audio/x-mpeg
- mp3 audio/x-mpeg
- ra audio/x-realaudio
- ram audio/x-pn-realaudio
- rm audio/vnd.rm-realmedia
- swa audio/mp3
- wav audio/wav
- wma audio/x-ms-wma
- )
- );
-
sub _refresh_filelist {
my ($self, $req, $article, $msg) = @_;
$file{contentType} = "application/octet-stream";
}
unless ($file{contentType}) {
- my $ext = lc $1;
- my $type = $types{$ext};
- unless ($type) {
- $type = $self->{cfg}->entry('extensions', $ext)
- || $self->{cfg}->entry('extensions', ".$ext")
- || "application/octet-stream";
- }
- $file{contentType} = $type;
+ $file{contentType} = content_type($self->cfg, $file);
}
}
require ArticleFiles;
my $fileobj = ArticleFiles->add(@file{@cols});
+ $req->flash("New file added");
+
+ my $storage = $cgi->param('storage');
+ defined $storage or $storage = 'local';
+ my $file_manager = $self->_file_manager($req->cfg);
+
+ local $SIG{__DIE__};
+ eval {
+ my $src;
+ $storage = $self->_select_filestore($req, $file_manager, $storage, $fileobj);
+ $src = $file_manager->store($filename, $storage, $fileobj);
+
+ if ($src) {
+ $fileobj->{src} = $src;
+ $fileobj->{storage} = $storage;
+ $fileobj->save;
+ }
+ };
+ if ($@) {
+ $req->flash($@);
+ }
+
use Util 'generate_article';
generate_article($articles, $article) if $Constants::AUTO_GENERATE;
- $self->_refresh_filelist($req, $article, 'New file added');
+ $self->_refresh_filelist($req, $article);
}
sub fileswap {
my ($file) = grep $_->{id} == $fileid, @files;
if ($file) {
+ if ($file->{storage} ne 'local') {
+ my $mgr = $self->_file_manager;
+ $mgr->unstore($self->{filename}, $self->{storage});
+ }
+
$file->remove($req->cfg);
}
}
$self->_refresh_filelist($req, $article, 'File deleted');
}
+# only some files can be stored remotely
+sub _select_filestore {
+ my ($self, $req, $mgr, $storage, $file) = @_;
+
+ my $store = $mgr->select_store($file->{filename}, $storage, $file);
+ if ($store ne 'local') {
+ if ($file->{forSale} || $file->{requireUser}) {
+ $store = 'local';
+ $req->flash("For sale or user required files can only be stored locally");
+ }
+ elsif ($file->{articleId} != -1 && $file->article->is_access_controlled) {
+ $store = 'local';
+ $req->flash("Files for access controlled articles can only be stored locally");
+ }
+ }
+
+ return $store;
+}
+
sub filesave {
my ($self, $req, $article, $articles) = @_;
my %errors;
my @old_files;
my @new_files;
+ my %store_anyway;
for my $file (@files) {
my $id = $file->{id};
my $desc = $cgi->param("description_$id");
defined $desc and $file->{description} = $desc;
my $type = $cgi->param("contentType_$id");
- defined $type and $file->{contentType} = $type;
+ if (defined $type and $type ne $file->{contentType}) {
+ ++$store_anyway{$id};
+ $file->{contentType} = $type;
+ }
my $notes = $cgi->param("notes_$id");
defined $notes and $file->{notes} = $notes;
my $name = $cgi->param("name_$id");
if length $file->{name};
}
if ($cgi->param('save_file_flags')) {
- $file->{download} = 0 + defined $cgi->param("download_$id");
+ my $download = 0 + defined $cgi->param("download_$id");
+ if ($download != $file->{download}) {
+ ++$store_anyway{$file->{id}};
+ $file->{download} = $download;
+ }
$file->{forSale} = 0 + defined $cgi->param("forSale_$id");
$file->{requireUser} = 0 + defined $cgi->param("requireUser_$id");
$file->{hide_from_list} = 0 + defined $cgi->param("hide_from_list_$id");
$display_name =~ s!.*[\\:/]!!;
$display_name =~ s/[^\w._-]+/_/g;
my $full_name = "$download_path/$file_name";
- push @old_files, $file->{filename};
+ push @old_files, [ $file->{filename}, $file->{storage} ];
push @new_files, $file_name;
$file->{filename} = $file_name;
+ $file->{storage} = 'local';
$file->{sizeInBytes} = -s $full_name;
$file->{whenUploaded} = now_datetime();
$file->{displayName} = $display_name;
return $self->edit_form($req, $article, $articles, undef, \%errors);
}
+ $req->flash('File information saved');
+ my $mgr = $self->_file_manager;
for my $file (@files) {
$file->save;
+
+ my $storage = $cgi->param("storage_$file->{id}");
+ defined $storage or $storage = 'local';
+ $storage = $self->_select_filestore($req, $mgr, $storage, $file);
+ if ($storage ne $file->{storage} || $store_anyway{$file->{id}}) {
+ my $old_storage = $file->{storage};
+ eval {
+ $file->{src} = $mgr->store($file->{filename}, $storage, $file);
+ $file->{storage} = $storage;
+ $file->save;
+
+ if ($old_storage ne $storage) {
+ $mgr->unstore($file->{filename}, $old_storage);
+ }
+ };
+ $@
+ and $req->flash("Could not move $file->{displayName} to $storage: $@");
+ }
}
# remove the replaced files
- unlink map "$download_path/$_", @old_files;
+ for my $file (@old_files) {
+ my ($filename, $storage) = @$file;
+
+ eval {
+ $mgr->unstore($filename, $storage);
+ };
+ $@
+ and $req->flash("Error removing $filename from $storage: $@");
+
+ unlink "$download_path/$filename";
+ }
use Util 'generate_article';
generate_article($articles, $article) if $Constants::AUTO_GENERATE;
- $self->_refresh_filelist($req, $article, 'File information saved');
+ $self->_refresh_filelist($req, $article);
}
sub tag_old_checked {
fields => \%file_fields,
section => $article->{id} == -1 ? 'Global File Validation' : 'Article File Validation');
+ my $store_anyway = 0;
my $desc = $cgi->param("description");
defined $desc and $file->{description} = $desc;
my $type = $cgi->param("contentType");
- defined $type and $file->{contentType} = $type;
+ if (defined $type && $file->{contentType} ne $type) {
+ ++$store_anyway;
+ $file->{contentType} = $type;
+ }
my $notes = $cgi->param("notes");
defined $notes and $file->{notes} = $notes;
my $name = $cgi->param("name");
}
if ($cgi->param('save_file_flags')) {
- $file->{download} = 0 + defined $cgi->param("download");
+ my $download = 0 + defined $cgi->param("download");
+ if ($download ne $file->{download}) {
+ ++$store_anyway;
+ $file->{download} = $download;
+ }
$file->{forSale} = 0 + defined $cgi->param("forSale");
$file->{requireUser} = 0 + defined $cgi->param("requireUser");
$file->{hide_from_list} = 0 + defined $cgi->param("hide_from_list");
}
- my @old_files;
+ my @old_file;
my @new_files;
my $filex = $cgi->param("file");
my $in_fh = $cgi->upload("file");
$display_name =~ s!.*[\\:/]!!;
$display_name =~ s/[^\w._-]+/_/g;
my $full_name = "$download_path/$file_name";
- push @old_files, $file->{filename};
+ @old_file = ( $file->{filename}, $file->{storage} );
push @new_files, $file_name;
$file->{filename} = $file_name;
$file->{sizeInBytes} = -s $full_name;
$file->{whenUploaded} = now_datetime();
$file->{displayName} = $display_name;
+ $file->{storage} = 'local';
}
else {
$errors{"file"} = $msg;
}
$file->save;
+ $req->flash('File information saved');
+ my $mgr = $self->_file_manager;
+
+ my $storage = $cgi->param('storage');
+ defined $storage or $storage = $file->{storage};
+ $storage = $self->_select_filestore($req, $mgr, $storage, $file);
+ if ($storage ne $file->{storage} || $store_anyway) {
+ my $old_storage = $file->{storage};
+ eval {
+ $file->{src} = $mgr->store($file->{filename}, $storage, $file);
+ $file->{storage} = $storage;
+ $file->save;
+
+ $mgr->unstore($file->{filename}, $old_storage)
+ if $old_storage ne $storage;
+ };
+ $@
+ and $req->flash("Could not move $file->{displayName} to $storage: $@");
+ }
+
# remove the replaced files
- unlink map "$download_path/$_", @old_files;
+ if (my ($old_name, $old_storage) = @old_file) {
+ $mgr->unstore($old_name, $old_storage);
+ unlink "$download_path/$old_name";
+ }
use Util 'generate_article';
generate_article($articles, $article) if $Constants::AUTO_GENERATE;
- $self->_refresh_filelist($req, $article, 'File information saved');
+ $self->_refresh_filelist($req, $article);
}
sub can_remove {
sub new {
my ($class, %parms) = @_;
+ $parms{cfg}
+ or die "Missing cfg parameter";
+
return bless \%parms, $class;
}
+sub cfg {
+ $_[0]{cfg}
+}
+
sub article_class_id {
my ($class, $id, $articles, $cfg) = @_;
sub image_url {
my ($self, $im) = @_;
- "/images/$im->{image}"
+ $im->{src} || "/images/$im->{image}"
}
sub _image {
my ($self, $im, $align, $url, $style) = @_;
- my $image_url = $self->image_url($im);
+ my $image_url = escape_html($self->image_url($im));
my $text = qq!<img src="$image_url" width="$im->{width}"!
. qq! height="$im->{height}" alt="! . escape_html($im->{alt}).'"'
BSE::Template->output_result($req, $result);
}
+sub flash {
+ my ($self, @msg) = @_;
+
+ my $msg = "@msg";
+ my @flash;
+ @flash = @{$self->session->{flash}} if $self->session->{flash};
+ push @flash, $msg;
+ $self->session->{flash} = \@flash;
+}
+
sub message {
my ($req, $errors) = @_;
my $msg = '';
+ my @lines;
if ($errors and keys %$errors) {
my @fields = $req->cgi->param;
my %work = %$errors;
}
my %seen;
@lines = grep !$seen{$_}++, @lines; # don't need duplicates
- $msg = join "<br />", map escape_html($_), @lines;
}
+ if ($req->session->{flash}) {
+ push @lines, @{$req->session->{flash}};
+ delete $req->session->{flash};
+ }
+ $msg = join "<br />", map escape_html($_), @lines;
if (!$msg && $req->cgi->param('m')) {
$msg = join(' ', $req->cgi->param('m'));
$msg = escape_html($msg);
--- /dev/null
+package BSE::Storage::AmazonS3;
+use strict;
+use BSE::Storage::Base;
+our @ISA = qw(BSE::Storage::Base);
+use Net::Amazon::S3;
+use Carp qw(confess);
+
+sub new {
+ my ($class, %opts) = @_;
+
+ my $self = $class->SUPER::new(%opts);
+
+ my $cfg = $self->cfg;
+ for my $key (qw/baseurl keyid accesskey bucket/) {
+ $self->{$key} = $self->configure($key);
+ defined $self->{$key}
+ or confess "Missing $key from configuration";
+ }
+ $self->{prefix} = $self->configure('prefix', '');
+
+ return $self;
+}
+
+sub _connect {
+ my $self = shift;
+
+ my $conn = Net::Amazon::S3->new
+ (
+ {
+ aws_access_key_id => $self->{keyid},
+ aws_secret_access_key => $self->{accesskey}
+ }
+ );
+
+ my $bucket = $conn->bucket($self->{bucket});
+
+ return ( $conn, $bucket );
+}
+
+sub store {
+ my ($self, $local_name, $basename, $http_extras) = @_;
+
+ #print STDERR "store($local_name, $basename)\n";
+
+ my ($conn, $bucket) = $self->_connect;
+ my %headers = %$http_extras;
+ $headers{acl_short} = "public-read";
+ $bucket->add_key_filename($self->{prefix} . $basename, $local_name,
+ \%headers)
+ or die "Cannot add file $local_name as $basename to S3: ",
+ $bucket->errstr, "\n";
+
+ return $self->{baseurl} . $basename;
+}
+
+sub unstore {
+ my ($self, $basename) = @_;
+
+ my ($conn, $bucket) = $self->_connect;
+ my $success = $bucket->delete_key($self->{prefix} . $basename);
+
+ return $success;
+}
+
+sub list {
+ my ($self) = @_;
+
+ my ($conn, $bucket) = $self->_connect;
+ use Data::Dumper;
+ my $result = $bucket->list_all({ prefix => $self->{prefix} });
+ my @keys = map $_->{key}, @{$result->{keys}};
+ for my $key (@keys) {
+ $key =~ s/^\Q$self->{prefix}//;
+ }
+
+ return @keys;
+}
+
+sub url {
+ my ($self, $basename) = @_;
+
+ $self->{baseurl} . $basename;
+}
+
+sub cmd {
+ my ($self, $cmd, @args) = @_;
+
+ if ($cmd eq 'create') {
+ my ($conn) = $self->_connect;
+ if ($conn->add_bucket(
+ {
+ bucket => $self->{bucket},
+ acl_short => 'public-read'
+ }
+ )) {
+ print "Bucket $self->{bucket} created\n";
+ }
+ else {
+ die "Could not create bucket $self->{bucket}: ", $conn->errstr;
+ }
+ }
+ elsif ($cmd eq 'delete') {
+ my ($conn, $bucket) = $self->_connect;
+ if ($bucket->delete_bucket) {
+ print "Bucket $self->{bucket} deleted\n";
+ }
+ else {
+ die "Could not delete bucket $self->{bucket}: ", $conn->errstr, "\n";
+ }
+ }
+ elsif ($cmd eq 'listbuckets') {
+ my ($conn) = $self->_connect;
+ my $buckets = $conn->buckets;
+ print $_->bucket, "\n" for @{$buckets->{buckets}};
+ }
+ elsif ($cmd eq 'help') {
+ print <<EOS;
+Usage: $0 storage command
+Possible commands:
+ create - the create the bucket for the given storage
+ delete - delete the bucket for the given storage
+ listbuckets - list the buckets for the account of the given storage
+ help - display this help
+EOS
+ }
+}
+
+1;
+
+=head1 NAME
+
+BSE::Storage::FTP - storage that stores via FTP.
+
+=head1 SYNOPSIS
+
+ [ftpimages]
+ class=BSE::Storage::FTP
+ baseurl=http://yourisp.com/images/
+ cwd=/public_html/images/
+ user=ftpuser
+ password=ftppassword
+ cond=...
+
+=head1 DESCRIPTION
+
+This is a BSE storage that accesses the remote store via FTP.
+
+=cut
--- /dev/null
+package BSE::Storage::Base;
+use strict;
+use Carp qw(confess);
+
+sub new {
+ my ($class, %opts) = @_;
+
+ defined $opts{cfg} and $opts{cfg}->can('entry')
+ or confess "Missing or invalid cfg option";
+
+ defined $opts{name} and $opts{name} =~ /^\w+$/
+ or confess "Missing or invalid storage name";
+
+ return bless \%opts, $class;
+}
+
+sub cfg {
+ $_[0]{cfg};
+}
+
+sub name {
+ $_[0]{name};
+}
+
+sub description {
+ my $self = shift;
+
+ $self->configure('description', $self->name);
+}
+
+sub section {
+ my $self = shift;
+
+ "storage " . $self->name;
+}
+
+sub configure {
+ my ($self, $key, $default) = @_;
+
+ return $self->cfg->entry($self->section, $key, $default);
+}
+
+sub match_file {
+ my ($self, $pathname, $filename, $object) = @_;
+
+ my $cond = $self->configure('cond');
+ defined $cond
+ or return 1;
+
+ my $result = eval <<EOS;
+stat \$pathname; # put stat values into _
+return $cond;
+EOS
+ $@ and die $@;
+
+ return $result;
+}
+
+1;
+
+=head1 NAME
+
+BSE::Storage::Base - base class for all storages
+
+=head1 SYNOPSIS
+
+ package BSE::Storage::Foo;
+ use base 'BSE::Storage::Base';
+ ...
+
+ # somewhere else
+ require BSE::Storage::Foo;
+ my $store = BSE::Storage::Foo->new(cfg => $cfg, name => $name);
+
+=head1 DESCRIPTION
+
+This will provide default implementations where necessary.
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=cut
--- /dev/null
+package BSE::Storage::FTP;
+use strict;
+use BSE::Storage::Base;
+our @ISA = qw(BSE::Storage::Base);
+use Net::FTP;
+use Carp qw(confess);
+
+sub new {
+ my ($class, %opts) = @_;
+
+ my $self = $class->SUPER::new(%opts);
+
+ my $cfg = $self->cfg;
+ for my $key (qw/baseurl host cwd user password/) {
+ $self->{$key} = $self->configure($key);
+ defined $self->{$key}
+ or confess "Missing $key from configuration";
+ }
+ $self->{passive} = $self->configure('passive', 0);
+ $self->{chmod} = $self->configure('chmod');
+
+ return $self;
+}
+
+sub _connect {
+ my ($self) = @_;
+
+ my $ftp = Net::FTP->new($self->{host}, Passive => $self->{passive});
+ $ftp
+ or die "Cannot connect via ftp to $self->{host}: $@\n";
+
+ $ftp->login($self->{user}, $self->{password})
+ or die "Cannot login to $self->{host}: ", $ftp->message, "\n";
+
+ $ftp->cwd($self->{cwd})
+ or die "Cannot cwd to $self->{cwd} on $self->{host}: ", $ftp->message, "\n";
+
+ $ftp->binary
+ or die "Cannot switch to binary mode on $self->{host}: ", $ftp->message, "\n";
+
+ return $ftp;
+}
+
+sub store {
+ my ($self, $local_name, $basename, $http_extras) = @_;
+
+ my $ftp = $self->_connect;
+ unless ($ftp->put($local_name, $basename)) {
+ my $put_error = $ftp->message;
+ # remove it, in case of a partial transfer
+ $ftp->delete($basename);
+ $ftp->quit;
+
+ die "Cannot store $local_name to $basename on $self->{host}: $put_error\n";
+ }
+
+ if ($self->{chmod}) {
+ unless ($ftp->site("chmod $self->{chmod} $basename")) {
+ my $chmod_error = $ftp->message;
+ # remove it, in case of a partial transfer
+ $ftp->delete($basename);
+ $ftp->quit;
+
+ die "Cannot chmod $local_name on $self->{host}: $chmod_error\n";
+ }
+ }
+
+ $ftp->quit;
+
+ return $self->{baseurl} . $basename;
+}
+
+sub unstore {
+ my ($self, $basename) = @_;
+
+ my $ftp = $self->_connect;
+ my $success = $ftp->delete($basename);
+ $ftp->quit;
+
+ return $success;
+}
+
+sub list {
+ my ($self) = @_;
+
+ my $ftp = $self->_connect;
+ my @files = $ftp->ls;
+ $ftp->quit;
+
+ return grep !/^\.\.?$/, @files;
+}
+
+sub url {
+ my ($self, $basename) = @_;
+
+ $self->{baseurl} . $basename;
+}
+
+1;
+
+=head1 NAME
+
+BSE::Storage::FTP - storage that stores via FTP.
+
+=head1 SYNOPSIS
+
+ [ftpimages]
+ class=BSE::Storage::FTP
+ baseurl=http://yourisp.com/images/
+ cwd=/public_html/images/
+ user=ftpuser
+ password=ftppassword
+ cond=...
+
+=head1 DESCRIPTION
+
+This is a BSE storage that accesses the remote store via FTP.
+
+=cut
--- /dev/null
+package BSE::Storage::LocalBase;
+use strict;
+use BSE::Storage::Base;
+our @ISA = qw(BSE::Storage::Base);
+
+sub unstore {
+ my ($self, $basename) = @_;
+ # nothing to do
+}
+
+sub sync {
+ # does nothing
+}
+
+sub description {
+ return 'Local';
+}
+
+1;
--- /dev/null
+package BSE::Storage::LocalFiles;
+use strict;
+use BSE::Storage::LocalBase;
+our @ISA = qw(BSE::Storage::LocalBase);
+
+sub store {
+ my ($self, $path, $basename) = @_;
+ # nothing to do
+
+ return '';
+}
+
+sub url {
+ my ($self, $basename, $object) = @_;
+
+ return '';
+}
+
+1;
--- /dev/null
+package BSE::Storage::LocalImages;
+use strict;
+use BSE::Storage::LocalBase;
+our @ISA = qw(BSE::Storage::LocalBase);
+
+sub store {
+ my ($self, $path, $basename) = @_;
+ # nothing to do
+
+ return '/images/' . $basename;
+}
+
+sub url {
+ my ($self, $basename) = @_;
+ '/images/' . $basename;
+}
+
+1;
--- /dev/null
+package BSE::StorageMgr::Base;
+use strict;
+use Carp 'confess';
+
+sub new {
+ my ($class, %opts) = @_;
+
+ $opts{cfg} && $opts{cfg}->can('entry')
+ or confess "cfg option missing";
+
+ $opts{debug} = $opts{cfg}->entry('storages', 'debug');
+
+ return bless \%opts, $class;
+}
+
+sub store {
+ my ($self, $filename, $key, $object) = @_;
+
+ my %http_extras = $self->metadata($object);
+
+ $self->{debug} and print STDERR "StorageMgr: store($filename, $key)\n";
+
+ return $self->_find_store($key)->
+ store($self->pathname($filename), $filename, \%http_extras);
+}
+
+sub select_store {
+ my ($self, $filename, $key, $object) = @_;
+
+ if ($key eq '') {
+ my $pathname = $self->pathname($filename);
+ for my $store ($self->all_stores) {
+ if ($store->match_file($pathname, $filename, $object)) {
+ return $store->name;
+ }
+ }
+
+ return 'local';
+ }
+ else {
+ return $key;
+ }
+}
+
+sub unstore {
+ my ($self, $filename, $key) = @_;
+
+ my $store = $self->_find_store($key)
+ or return;
+
+ return $store->unstore($filename);
+}
+
+sub cfg {
+ $_[0]{cfg};
+}
+
+sub all_stores {
+ my $self = shift;
+
+ $self->{loaded} or $self->_load_stores;
+
+ return @{$self->{ordered}};
+}
+
+sub local_store {
+ my $self = shift;
+
+ $self->{loaded} or $self->_load_stores;
+
+ return $self->{local_store};
+}
+
+sub pathname {
+ my ($self, $filename) = @_;
+
+ return $self->filebase . $filename;
+}
+
+sub sync {
+ my ($self, %opts) = @_;
+
+ my $print = $opts{print};
+
+ my @all_files = $self->files;
+ for my $store (grep $_->name ne 'local', $self->all_stores) {
+ my $name = $store->name;
+
+ $print and $print->("Storage ", $store->description, " ($name)");
+
+ my @files = $store->list;
+ my %files = map { $_ => 1 } @files;
+ my @need_files = grep $_->[1] eq $name, @all_files;
+ my %good_files = map { $_->[0] => 1 } grep $files{$_->[0]}, @need_files;
+ my @missing_files = grep !$good_files{$_->[0]}, @need_files;
+ my @extra_files = grep !$good_files{$_}, @files;
+
+ if (@missing_files) {
+ $print
+ and $print->(" ", scalar(@missing_files), " missing - transferring:");
+ for my $file (@missing_files) {
+ print " $file->[0]\n";
+ my $src = $self->store(@$file);
+ $self->set_src($file->[2], $src);
+ }
+ }
+ if (@extra_files) {
+ $print and
+ $print->(" ", scalar(@extra_files), " extra files found, removing:");
+ for my $file (@extra_files) {
+ $print
+ and $print->(" $file");
+ $self->unstore($file, $name);
+ }
+ }
+ }
+
+ my $local_store = $self->local_store;
+ for my $file (grep $_->[1] eq 'local', @all_files) {
+ $self->set_src($file->[2], $local_store->url($file->[0], $file->[2]));
+ }
+}
+
+sub fixsrc {
+ my $self = shift;
+
+ for my $file ($self->files) {
+ my $store = $self->_find_store($file->[1]);
+ $self->set_src($file->[2], $store->url($file->[0]));
+ }
+}
+
+sub _load_stores {
+ my ($self) = @_;
+
+ my @keys = split /,/, $self->cfg->entry('storages', $self->type, '');
+
+ if (grep $_ eq 'local', @keys) {
+ die "You cannot include the local storage in the configured storage list\n";
+ }
+
+ my %stores;
+ my @stores;
+ my $cfg = $self->cfg;
+ for my $key (@keys) {
+ my $section = "storage $key";
+ my $class = $cfg->entry($section, 'class')
+ or die "No class defined in [$section] for storage $key\n";
+
+ (my $file = $class . ".pm") =~ s(::)(/)g;
+ require $file;
+ my $store = $class->new(cfg => $cfg, name => $key);
+
+ $stores{$key} = $store;
+ push @stores, $store;
+ }
+ my $local = $self->local_class->new(cfg => $cfg, name => 'local');
+ $stores{local} = $local;
+ push @stores, $local;
+
+ $self->{stores} = \%stores;
+ $self->{ordered} = \@stores;
+ $self->{local_store} = $local;
+
+ ++$self->{loaded};
+}
+
+sub _find_store {
+ my ($self, $key) = @_;
+
+ $self->{loaded} or $self->_load_stores;
+
+ my $store = $self->{stores}{$key}
+ or die "Unknown store $key\n";
+
+ return $store;
+}
+
+1;
--- /dev/null
+package BSE::StorageMgr::Files;
+use strict;
+use BSE::StorageMgr::Base;
+our @ISA = qw(BSE::StorageMgr::Base);
+use BSE::Storage::LocalFiles;
+use BSE::Util::ContentType qw(content_type);
+
+sub filebase {
+ my ($self) = @_;
+
+ my $path = $self->cfg->entryVar('paths', 'downloads');
+
+ $path =~ m!/$! or $path .= '/';
+
+ return $path;
+}
+
+sub local_class {
+ return 'BSE::Storage::LocalFiles';
+}
+
+sub type {
+ 'files';
+}
+
+sub files {
+ require ArticleFiles;
+ return ArticleFiles->file_storages;
+}
+
+sub metadata {
+ my ($self, $file) = @_;
+
+ if ($file->{download}) {
+ return
+ (
+ content_type => "application/octet-stream",
+ content_disposition => "attachment; filename=$file->{displayName}",
+ );
+ }
+ else {
+ return
+ (
+ content_type => $file->{contentType},
+ content_disposition => "inline; filename=$file->{displayName}",
+ );
+ }
+}
+
+sub set_src {
+ my ($self, $file, $src) = @_;
+
+ $file->{src} = $src;
+ $file->save;
+}
+
+
+1;
--- /dev/null
+package BSE::StorageMgr::Images;
+use strict;
+use BSE::StorageMgr::Base;
+our @ISA = qw(BSE::StorageMgr::Base);
+use BSE::CfgInfo qw(cfg_image_dir);
+use BSE::Storage::LocalImages;
+use BSE::Util::ContentType qw(content_type);
+
+sub filebase {
+ my ($self) = @_;
+
+ return cfg_image_dir($self->cfg);
+}
+
+sub local_class {
+ return 'BSE::Storage::LocalImages';
+}
+
+sub type {
+ 'images';
+}
+
+sub files {
+ require Images;
+ return Images->image_storages;
+}
+
+sub metadata {
+ my ($self, $image) = @_;
+
+ return
+ (
+ content_type => content_type($self->{cfg}, $image->{image})
+ );
+}
+
+sub set_src {
+ my ($self, $image, $src) = @_;
+
+ $image->{src} = $src;
+ $image->save;
+}
+
+1;
"This file can only be downloaded as part of an order"));
# check the user has access to this file (RT#531)
+ my $article;
if ($file->{articleId} != -1) {
require Articles;
- my $article = Articles->getByPkey($file->{articleId})
+ $article = Articles->getByPkey($file->{articleId})
or return $self->req_show_logon($req,
$msgs->('downloadarticle',
"Could not load article for file"));
}
}
}
+
+ # this this file is on an external storage, and qualifies for
+ # external storage send the user to get it from there
+ if ($file->{src} && $file->{storage} ne 'local'
+ && !$file->{forSale} && !$file->{requireUser}
+ && (!$article || !$article->is_access_controlled)) {
+ refresh_to($file->{src});
+ return;
+ }
my $filebase = $cfg->entryVar('paths', 'downloads');
open FILE, "< $filebase/$file->{filename}"
--- /dev/null
+package BSE::Util::ContentType;
+use strict;
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(content_type);
+
+my %types =
+ (
+ qw(
+ bash text/plain
+ css text/css
+ csv text/plain
+ diff text/plain
+ htm text/html
+ html text/html
+ ics text/calendar
+ patch text/plain
+ pl text/plain
+ pm text/plain
+ pod text/plain
+ py text/plain
+ sgm text/sgml
+ sgml text/sgml
+ sh text/plain
+ tcsh text/plain
+ text text/plain
+ tsv text/tab-separated-values
+ txt text/plain
+ vcf text/x-vcard
+ vcs text/x-vcalendar
+ xml text/xml
+ zsh text/plain
+ bmp image/bmp
+ gif image/gif
+ jp2 image/jpeg2000
+ jpeg image/jpeg
+ jpg image/jpeg
+ pct image/pict
+ pict image/pict
+ png image/png
+ tif image/tiff
+ tiff image/tiff
+ dcr application/x-director
+ dir application/x-director
+ doc application/msword
+ dxr application/x-director
+ eps application/postscript
+ fla application/x-shockwave-flash
+ flv application/x-shockwave-flash
+ gz application/gzip
+ hqx application/mac-binhex40
+ js application/x-javascript
+ lzh application/x-lzh
+ pdf application/pdf
+ pps application/ms-powerpoint
+ ppt application/ms-powerpoint
+ ps application/postscript
+ rtf application/rtf
+ sit application/x-stuffit
+ swf application/x-shockwave-flash
+ tar application/x-tar
+ tgz application/gzip
+ xls application/ms-excel
+ Z application/x-compress
+ zip application/zip
+ asf video/x-ms-asf
+ avi video/avi
+ flc video/flc
+ moov video/quicktime
+ mov video/quicktime
+ mp4 video/mp4
+ mpeg video/mpeg
+ mpg video/mpeg
+ wmv video/x-ms-wmv
+ 3gp video/3gpp
+ aa audio/audible
+ aif audio/aiff
+ aiff audio/aiff
+ m4a audio/m4a
+ mid audio/midi
+ mp2 audio/x-mpeg
+ mp3 audio/x-mpeg
+ ra audio/x-realaudio
+ ram audio/x-pn-realaudio
+ rm audio/vnd.rm-realmedia
+ swa audio/mp3
+ wav audio/wav
+ wma audio/x-ms-wma
+ )
+ );
+
+sub content_type {
+ my ($cfg, $filename) = @_;
+
+ if ($filename =~ /\.(\w+)$/) {
+ my $ext = lc $1;
+ my $type = $types{$ext};
+ unless ($type) {
+ $type = $cfg->entry('extensions', $ext)
+ || $cfg->entry('extensions', ".$ext")
+ || "application/octet-stream";
+ }
+
+ return $type;
+ }
+ else {
+ return "application/octet-stream";
+ }
+}
+
\"[^"]*\"
|
\[[^\]\[]+?\]
+ |
+ \[(?:[^\]\[]*\[[^\]\[]*\])+[^\]\[]*\]
)
)*
)
return $text;
}
-sub _make_img {
- my ($args, $imagePos, $images) = @_;
-
- my ($index, $align, $url) = split /\|/, $args, 3;
- my $text = '';
- if ($index >=1 && $index <= @$images) {
-# I considered this
-# if (!$align) {
-# $align = $$imagePos =~ /r/ ? 'right' : 'left';
-# $$imagePos =~ tr/rl/lr/; # I wonder
-# }
- my $im = $images->[$index-1];
- $text = qq!<img src="/images/$im->{image}" width="$im->{width}"!
- . qq! height="$im->{height}" alt="! . escape_html($im->{alt}).'"'
- . qq! border="0"!;
- $text .= qq! align="$align"! if $align && $align ne 'center';
- $text .= qq! />!;
- $text = qq!<div align="center">$text</div>!
- if $align && $align eq 'center';
- if (!$url && $im->{url}) {
- $url = $im->{url};
- }
- if ($url) {
- $text = qq!<a href="! . escape_html($url) . qq!">$text</a>!;
- }
- }
- return $text;
-}
-
sub formatter_class {
require BSE::Formatter::Article;
return 'BSE::Formatter::Article'
sub image_url {
my ($self, $im) = @_;
- "/images/$im->{image}";
+ $im->{src} || "/images/$im->{image}";
}
sub _format_image {
my ($self, $im, $align, $rest) = @_;
if ($align && exists $im->{$align}) {
- return escape_html($im->{$align});
+ if ($align eq 'src') {
+ my $src = $self->image_url($im);
+ return escape_html($im);
+ }
+ else {
+ return escape_html($im->{$align});
+ }
}
else {
my $image_url = $self->image_url($im);
}
if ($im) {
- return qq!<img src="/images/$im->{image}" width="$im->{width}"!
+ my $src = $im->{src} || "/images/$im->{image}";
+ $src = escape_html($src);
+ return qq!<img src="$src" width="$im->{width}"!
. qq! height="$im->{height}" alt="$title" />!;
}
else {
@ISA = qw/Squirrel::Row/;
sub columns {
- return qw/id articleId image alt width height url displayOrder name/;
+ return qw/id articleId image alt width height url displayOrder name
+ storage src/;
}
1;
return 'Image';
}
+sub image_storages {
+ return map [ $_->{image}, $_->{storage}, $_ ], Images->all;
+}
+
1;
'formmail.html',
'userupdate.html',
'siteusers.html',
+ 'storages.html',
);
my @exts = qw(.pod .pm .pl);
--- /dev/null
+=head1 NAME
+
+storages.pod - external image and file stores
+
+=head1 SYNOPSIS
+
+ [storages]
+ images=istore1,istore2
+ files=fstore1,fstore2
+
+ [storage istore1]
+ class=BSE::Storage::AmazonS3
+ baseurl=http://.../images/
+ keyid=...
+ accesskey=...
+ bucket=...
+ prefix=images/
+ description=Images on Amazon S3
+
+ [storage istore2]
+ class=BSE::Storage::FTP
+ baseurl=http://.../images/
+ host=ftphost
+ user=ftpuser
+ password=ftppassword
+ cwd=/public_html/images
+ chmod=644
+ description=Images on Somehost
+
+=head1 DESCRIPTION
+
+BSE allows you to have images and file served from a remote server.
+This can be useful:
+
+=over
+
+=item *
+
+to reduce bandwidth usage on your dynamic server
+
+=item *
+
+to reduce CPU load - though this shouldn't be significant from
+file/image transfers in any case
+
+=back
+
+=head1 FILE STORAGE
+
+Unlike images, files attached to images can be limited to either
+require that a user be logged in, that the file be available only on
+purchase or access limited by the user's access rights in the article
+or it's parents.
+
+Hence, if a file is marked for sale, user required, or the article it
+belongs to is access controlled, the files cannot be stored remotely.
+
+Also the marking of files for download, the display name and
+specifying the content type is only supported by the Amazon S3
+storage.
+
+=head1 CONFIGURATION
+
+Each type of file has a list of stores where their associated files
+can be stored, which is set in the [storages] section of the config
+file as a comma delimited list of tokens.
+
+A "local" storage for the given file type is added to the end of that
+list. This storage has no configuration.
+
+Each of these tokens then refers to another configuration section
+C<[storage >I<token>C<]> with the definition for that store.
+
+Each storage section B<must> have a C<class> token which defines the
+storage class.
+
+Other common tokens include:
+
+=over
+
+=item *
+
+description - the description of the storage as displayed in drop down
+lists.
+
+=item *
+
+baseurl - the base url the image filename is appended to to obtain the
+final file source url.
+
+=item *
+
+cond - a perl expression, if the users chooses (Auto) from the
+storages drop down then the first storage when cond evals to a true
+value will be used. If none are true the local storage is used. This
+expression is ignored if the user selects a particular storage.
+
+=back
+
+=head1 STORAGE CLASSES
+
+=head2 BSE::Storage::AmazonS3
+
+This stores the files on Amazon's Simple Storage Service.
+
+This storage supports storing content types and dispositions, so
+supports BSE's distinction between retrieving files for download or
+for inline display.
+
+=over
+
+=item *
+
+keyid - "Your Access Key ID" from the AWS Access Identifiers page.
+Required.
+
+=item *
+
+accesskey - " Your Secret Access Key" from the AWS Access Identifiers
+page. Required.
+
+=item *
+
+bucket - the name of the S3 bucket to store the files in. Required.
+
+=item *
+
+prefix - the prefix applied to filenames stored in this bucket. This
+combined with the bucket must be unique amongst the storages you
+create. Required.
+
+=back
+
+The bse_s3.pl tool can be used for basic setup.
+
+To create the bucket associated with a storage:
+
+ perl bse_s3.pl istore1 create
+
+To delete the bucket associated with a storage:
+
+ perl bse_s3.pl istore1 create
+
+The bucket must be empty before doing this.
+
+To list all buckets for the account associated with a storage:
+
+ perl bse_s3.pl istore1 listbuckets
+
+=head2 BSE::Storage::FTP
+
+This storage transfers files to an FTP server.
+
+Without complex apache setup this storage is only useful for images,
+since it doesn't support BSE's distinction between inline and
+attachment for files.
+
+=over
+
+=item *
+
+host - the ftp host to transfer the files to. Required.
+
+=item *
+
+user - the FTP user. Required.
+
+=item *
+
+password - the FTP password. Required.
+
+=item *
+
+cwd - the storage will change to this directory before
+uploading/removing files. Required.
+
+=item *
+
+chmod - if set then any files uploaded will be chmod to the given
+mask. Optional but recommended that this be set to 644.
+
+=back
+
+=head1 MAINTENANCE
+
+The bse_storage.pl can be use for simple maintenance tasks.
+
+=head2 Synchronization
+
+If you've manually removed or added files to the storage or updated
+the storage field in the C<image> or C<article_files> tables you can
+resynchronize the storage state to the database.
+
+ perl bse_storage.pl sync
+
+To see what differences were found run with the -v option:
+
+ perl bse_storage.pl -v sync
+
+This will also update the file src for each file found to be out of
+sync.
+
+For example, if you want to force all images to be stored on the
+storage C<s3_images> you would do the following in SQL:
+
+ update image set storage='s3_images';
+
+then run:
+
+ perl bse_storage.pl -v sync
+
+and you might see:
+
+ Type files
+ Storage S3 Files (s3_files)
+ Type images
+ Storage S3 Images (s3_images)
+ 11 missing - transferring:
+ 1180071938_kscdisplay.png
+ 1180071915_209_yonge.jpg
+ 1180328212_t105gray-perturb.gif
+ 1180743047_test.jpg
+ 1180745768_t50out.gif
+ 1188193066_foo.png
+ 1189397083_dnangel_01_1280.jpg
+ 1189411047_dnangel_18_1024.jpg
+ 1195003780_anzscin2.jpg
+ 1195002521_1194062541_anzscin2.png
+ 1202278171_result.png
+ Storage FTP Images (ftp_images)
+
+or to bulk remove files from the storage:
+
+ update image set storage='local';
+
+ Type files
+ Storage S3 Files (s3_files)
+ Type images
+ Storage S3 Images (s3_images)
+ 12 extra files found, removing:
+ 1180071915_209_yonge.jpg
+ 1180071938_kscdisplay.png
+ 1180328212_t105gray-perturb.gif
+ 1180743047_test.jpg
+ 1180745768_t50out.gif
+ 1188193066_foo.png
+ 1189397083_dnangel_01_1280.jpg
+ 1189411047_dnangel_18_1024.jpg
+ 1195002521_1194062541_anzscin2.png
+ 1195003780_anzscin2.jpg
+ 1202278171_result.png
+ 1202437879_t101.jpg
+ Storage FTP Images (ftp_images)
+
+=head2 Storage Contents
+
+You can see what files are stored in which storages with the list command:
+
+ perl bse_storage.pl list
+
+=head2 URL Updates
+
+If you reconfigure the base URL for a storage you can do:
+
+ perl bse_storage.pl fixsrc
+
+to update the stored URL for every file.
+
+This should also be done when updating to a version of BSE with
+storages to fix the src for images.
+
+=head1 CNAME and S3
+
+To avoid sending your users to
+http://I<bucket>.s3.amazonaws.com/... for your data you can create a
+CNAME named for your bucket that points at I<bucket>.s3.amazonaws.com.
+
+eg. given a base site name of http://bsetest.develop-help.com we
+create a bucket called "images.bsetest.develop-help.com" and create a
+CNAME like so:
+
+; in the develop-help.com zone file
+images.bsetest IN CNAME images.bsetest.develop-help.com.s3.amazonaws.com.
+
+We can then set the baseurl using that name:
+
+ baseurl=http://images.bsetest.develop-help.com/images/
+ prefix=images/
+
+For more information see "Virtual Hosting of Buckets" under "Using the
+REST API" in the Amazone Simple Storage Service Developer Guide.
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=cut
</td>
<td nowrap="nowrap" bgcolor="#FFFFFF"><:help image name:> <:error_img name:></td>
</tr>
+ <tr>
+ <th bgcolor="#FFFFFF" align="left">Storage:</th>
+ <td bgcolor="#FFFFFF">
+<select name="storage">
+<option value="">(Auto)</option>
+<:iterator begin image_stores:>
+<option value="<:image_store name:>"><:image_store description:></option>
+<:iterator end image_stores:>
+</select>
+ </td>
+ <td nowrap="nowrap" bgcolor="#FFFFFF"><:help image storage:> <:error_img storage:></td>
+ </tr>
<tr>
<td bgcolor="#FFFFFF" colspan="3" align="right">
<input type="submit" name="addimg" value="Add Image" />
</tr>
<:iterator begin images:>
<tr>
- <td rowspan="4" align="center" valign="center" bgcolor="#FFFFFF"><a href="#" onclick="window.open('/images/<:image image:>', 'fullimage', 'width=<:arithmetic [image width]+20:>,height=<:arithmetic [image height] + 30:>,location=no,status=no,menubar=no,scrollbars=yes'); return false;"><:thumbimage editor:></a></th>
+ <td rowspan="5" align="center" valign="center" bgcolor="#FFFFFF"><a href="#" onclick="window.open('<:image src:>', 'fullimage', 'width=<:arithmetic [image width]+20:>,height=<:arithmetic [image height] + 30:>,location=no,status=no,menubar=no,scrollbars=yes'); return false;"><:thumbimage editor:></a></th>
<th>Alt text:</th>
<td valign="top" bgcolor="#FFFFFF">
<:ifUserCan edit_images_save:article:><input type="text" name="alt<:image id:>" value="<: oldi [concatenate alt [image id] ] 0 image alt :>" size="32" /><:or:><: image alt :><:eif:>
</td>
- <td valign="top" nowrap="nowrap" rowspan="4" bgcolor="#FFFFFF">
+ <td valign="top" nowrap="nowrap" rowspan="5" bgcolor="#FFFFFF">
<:ifUserCan edit_images_delete:article:><b><a href="<:script:>?id=<:article id:>&removeimg_<: image id :>=1&_t=img" onClick="return window.confirm('Are you sure you want to delete this Image')">Delete</a></b><:or:><:eif:>
<:ifUserCan edit_images_save:article:><a href="<:script:>?a_edit_image=1&id=<:article id:>&image_id=<: image id :>">Edit</a><:or:><:eif:></td>
- <td nowrap="nowrap" bgcolor="#FFFFFF" rowspan="4"><:imgmove:></td>
+ <td nowrap="nowrap" bgcolor="#FFFFFF" rowspan="5"><:imgmove:></td>
</tr>
<tr>
<th>URL:</th>
- <td valign="top" width="50%" bgcolor="#FFFFFF"colspan="1">
+ <td valign="top" width="50%" bgcolor="#FFFFFF" colspan="1">
<:ifUserCan edit_images_save:article:><input type="text" name="url<:image id:>" value="<: oldi [concatenate url [image id] ] 0 image url :>" size="32" /><:or:><: image url :><:eif:>
</td>
</tr>
<tr>
<th>Identifier:</th>
- <td valign="top" nowrap="nowrap" bgcolor="#FFFFFF"colspan="1">
+ <td valign="top" nowrap="nowrap" bgcolor="#FFFFFF" colspan="1">
<:ifUserCan edit_images_save:article:><input type="text" name="name<:image id:>" value="<: oldi [concatenate name [image id] ] 0 image name :>" size="32" /> <:error_img [concatenate "name" [image id] ]:><:or:><: image name :><:eif:>
</td>
</tr>
<tr>
<th>Image file:</th>
- <td valign="top" nowrap="nowrap" bgcolor="#FFFFFF"colspan="1">
+ <td valign="top" nowrap="nowrap" bgcolor="#FFFFFF" colspan="1">
<:ifUserCan edit_images_save:article:><input type="file" name="image<:image id:>" size="32" /> <:error_img [concatenate "image" [image id] ]:><:or:><: image displayName :><:eif:>
</td>
</tr>
+ <tr>
+ <th>Stored:</th>
+ <td valign="top" nowrap="nowrap" bgcolor="#FFFFFF" colspan="1">
+ <:ifUserCan edit_images_save:article:><select name="storage<:image id:>">
+<option value="">(Auto)</option>
+<:iterator begin image_stores:>
+<option value="<:image_store name:>" <:ifEq [oldi [concatenate storage [image id] ] 0 image storage] [image_store name]:>selected="selected"<:or:><:eif:>><:image_store description:></option>
+<:iterator end image_stores:>
+</select><:error_img [concatenate "storage" [image id] ]:><:or:><: image storage :><:eif:>
+ </td>
+ </tr>
<:iterator end images:>
<:or Thumbs:>
<tr bgcolor="#FFFFFF">
</tr>
<: iterator begin images :>
<tr bgcolor="#FFFFFF">
- <td align="center" colspan="5"> <img src="/images/<: image image :>" alt="<: image alt :>" width="<:
+ <td align="center" colspan="5"> <img src="<: image src :>" alt="<: image alt :>" width="<:
image width :>" height="<: image height :>" /></td>
</tr>
<tr bgcolor="#FFFFFF">
<td nowrap><a href="/cgi-bin/admin/add.pl?id=<:product id:>">Edit</a>
<:if Product listed:> <a href="/cgi-bin/admin/add.pl?hide=1&id=<:product id:>&r=<:cfg site url:><:script:>">Hide</a>
<:or Product:> <a href="/cgi-bin/admin/add.pl?unhide=1&id=<:product id:>&r=<:cfg site url:><:script:>">Show</a>
- <:eif Product:> <:move:> </td>
+ <:eif Product:> <:move:> x<:product customStr1:>y</td>
<td><:hiddenNote:></td>
</tr>
<:iterator end products:>
</td>
<td nowrap="nowrap"><:help file hide_from_list:> <:error_img hide_from_list:></td>
</tr>
+ <tr>
+ <th align="left">Storage:</th>
+ <td>
+<select name="storage">
+<option value="">(Auto)</option>
+<:iterator begin file_stores:>
+<option value="<:file_store name:>" <:ifEq [efile storage] [file_store name]:>selected="selected"<:or:><:eif:>><:file_store description:></option>
+<:iterator end file_stores:>
+</select>
+ </td>
+ <td nowrap="nowrap"><:help file hide_from_list:> <:error_img hide_from_list:></td>
+ </tr>
<tr>
<td colspan="3" align="right">
<input type="submit" name="a_save_file" value="Save File" />
</td>
<td nowrap="nowrap" bgcolor="#FFFFFF"><:help file hide_from_list:> <:error_img hide_from_list:></td>
</tr>
+ <tr>
+ <th bgcolor="#FFFFFF" align="left">Storage:</th>
+ <td bgcolor="#FFFFFF">
+<select name="storage">
+<option value="">(Auto)</option>
+<:iterator begin file_stores:>
+<option value="<:file_store name:>"><:file_store description:></option>
+<:iterator end file_stores:>
+</select>
+
+ </td>
+ <td nowrap="nowrap" bgcolor="#FFFFFF"><:help file hide_from_list:> <:error_img hide_from_list:></td>
+ </tr>
<tr>
<td bgcolor="#FFFFFF" colspan="3" align="right">
<input type="submit" name="fileadd" value="Add File" />
</td>
</tr>
<tr>
- <td valign="top" colspan="2" nowrap="nowrap" bgcolor="#FFFFFF">
+ <td valign="top" nowrap="nowrap" bgcolor="#FFFFFF">
Identifier: <:ifUserCan edit_files_save:article:><input name="name_<:file id:>" type="text" value="<: oldi [concatenate name_ [file id]] 0 file name :>" size="20" /><:error_img [concatenate name_ [file id]]:>
<:or:><: file name :><:eif:>
</td>
+ <td valign="top" nowrap="nowrap" bgcolor="#FFFFFF">
+ Storage: <:ifUserCan edit_files_save:article:><select name="storage_<:file id:>"><option value="">(Auto)</option>
+<:iterator begin file_stores:>
+<option value="<:file_store name:>" <:ifEq [oldi [concatenate storage_ [file id] ] 0 file storage] [file_store name]:>selected="selected"<:or:><:eif:>><:file_store description:></option>
+<:iterator end file_stores:></select><:error_img [concatenate storage_ [file id]]:>
+ <:or:><: file storage :><:eif:>
+ </td>
</tr>
<tr bgcolor="#FFFFFF">
<td colspan="3">
<p>| <a href="/cgi-bin/admin/menu.pl">Admin menu</a> |
<a href="<:article admin:>">See article</a> |
<a href="/cgi-bin/admin/add.pl?id=<:article id:>">Edit Article</a> |
-<a href="/cgi-bin/admin/add.pl?id=<:article id:>">Images</a> |
+<a href="/cgi-bin/admin/add.pl?id=<:article id:>&_t=img">Images</a> |
</p>
<form action="/cgi-bin/admin/add.pl" method="post" enctype="multipart/form-data">
<td><input type="text" name="name" value="<:old name eimage name:>" /></td>
<td nowrap="nowrap"><:help image name:> <:error_img name:></td>
</tr>
+ <tr>
+ <th align="left">Storage:</th>
+ <td>
+<select name="storage">
+<option value="">(Auto)</option>
+<:iterator begin image_stores:>
+<option value="<:image_store name:>" <:ifEq [old storage eimage storage] [image_store name]:>selected="selected"<:or:><:eif:>><:image_store description:></option>
+<:iterator end image_stores:>
+</select>
+ </td>
+ <td nowrap="nowrap"><:help image name:> <:error_img name:></td>
+ </tr>
<tr>
<td colspan="3" align="right">
<input type="submit" name="a_save_image" value="Save Image" />
--- /dev/null
+#!perl -w
+use strict;
+use lib '../cgi-bin/modules';
+use BSE::Cfg;
+use BSE::Storage::AmazonS3;
+
+chdir "$FindBin::Bin/../cgi-bin"
+ or warn "Could not change to cgi-bin directory: $!\n";
+
+my $cfg = BSE::Cfg->new;
+
+my $store_name = shift;
+my $action = shift
+ or die "Usage: $0 storage action\n";
+
+$cfg->entry("storage $store_name", "class", '') eq 'BSE::Storage::AmazonS3'
+ or die "$0: $store_name is not an S3 storage\n";
+my $store = BSE::Storage::AmazonS3->new(cfg => $cfg, name => $store_name);
+$store->cmd($action, @ARGV);
--- /dev/null
+#!perl -w
+use strict;
+use lib '../cgi-bin/modules';
+use BSE::Cfg;
+use BSE::StorageMgr::Images;
+use BSE::StorageMgr::Files;
+use Getopt::Long;
+
+my $verbose;
+
+GetOptions("v", \$verbose);
+
+chdir "$FindBin::Bin/../cgi-bin"
+ or warn "Could not change to cgi-bin directory: $!\n";
+
+my $cfg = BSE::Cfg->new;
+
+my $images = BSE::StorageMgr::Images->new(cfg => $cfg);
+my $files = BSE::StorageMgr::Files->new(cfg => $cfg);
+my %stores =
+ (
+ images => $images,
+ files => $files,
+ );
+
+my $action = shift;
+
+if ($action eq 'list') {
+ for my $type (sort keys %stores) {
+ my @stores = $stores{$type}->all_stores;
+ print "Type $type\n";
+ for my $store (grep $_->name ne 'local', @stores) {
+ print " Storage ", $store->description, " (", $store->name, ")\n";
+ print " $_\n" for $store->list;
+ }
+ }
+}
+elsif ($action eq 'sync') {
+ my %opts;
+
+ if ($verbose) {
+ $opts{print} = sub { print " ", @_, "\n"; };
+ }
+ for my $type (sort keys %stores) {
+ print "Type $type\n" if $verbose;
+ my $mgr = $stores{$type};
+ $mgr->sync(%opts);
+ }
+}
+elsif ($action eq 'fixsrc') {
+ for my $type (sort keys %stores) {
+ print "Type $type\n" if $verbose;
+ $stores{$type}->fixsrc;
+ }
+}
+else {
+ print <<EOS;
+Usage: $0 [-v] command
+ -v - display progress information
+Commands:
+ list - list the files stored on each non-local storage
+ sync - synchronize the files stored to the storages selected in
+ their records
+EOS
+}
Column notes;text;NO;;
Column name;varchar(80);NO;;
Column hide_from_list;int(11);NO;0;
+Column storage;varchar(20);NO;local;
+Column src;varchar(255);NO;;
Index PRIMARY;1;[id]
Table bse_article_groups
Column article_id;int(11);NO;;
Column url;varchar(255);YES;NULL;
Column displayOrder;int(11);NO;0;
Column name;varchar(255);NO;;
+Column storage;varchar(20);NO;local;
+Column src;varchar(255);NO;;
Index PRIMARY;1;[id]
Table order_item
Column id;int(11);NO;NULL;auto_increment
projects / bse.git / commitdiff