site/cgi-bin/modules/BSE/EmailBlacklist.pm
site/cgi-bin/modules/BSE/EmailRequest.pm
site/cgi-bin/modules/BSE/EmailRequests.pm
+site/cgi-bin/modules/BSE/FileBehaviour.pm
site/cgi-bin/modules/BSE/FileHandler/Base.pm
site/cgi-bin/modules/BSE/FileHandler/Default.pm
site/cgi-bin/modules/BSE/FileHandler/FLV.pm
site/cgi-bin/modules/BSE/TB/AuditLog.pm
site/cgi-bin/modules/BSE/TB/BackgroundTask.pm
site/cgi-bin/modules/BSE/TB/BackgroundTasks.pm
+site/cgi-bin/modules/BSE/TB/File.pm
site/cgi-bin/modules/BSE/TB/FileAccessLog.pm
site/cgi-bin/modules/BSE/TB/FileAccessLogEntry.pm
+site/cgi-bin/modules/BSE/TB/Files.pm
site/cgi-bin/modules/BSE/TB/Image.pm
site/cgi-bin/modules/BSE/TB/Images.pm
site/cgi-bin/modules/BSE/TB/Location.pm
site/cgi-bin/modules/BSE/Thumb/Imager/Colourize.pm
site/cgi-bin/modules/BSE/Thumb/Imager/RandomCrop.pm
site/cgi-bin/modules/BSE/ThumbLow.pm
+site/cgi-bin/modules/BSE/UI.pm
site/cgi-bin/modules/BSE/UI/AdminAudit.pm
site/cgi-bin/modules/BSE/UI/AdminDispatch.pm
site/cgi-bin/modules/BSE/UI/AdminMessages.pm
site/templates/admin/locations/view_sessions.tmpl
site/templates/admin/log/entry.tmpl
site/templates/admin/log/log.tmpl
+site/templates/admin/log/mail.tmpl
site/templates/admin/logon.tmpl
site/templates/admin/memberupdate/import.tmpl
site/templates/admin/memberupdate/preview.tmpl
$conf{paths}{downloads} = $uploads;
my $templates = "$instbase/templates";
$conf{paths}{templates} = $templates;
+$conf{paths}{public_html} = "$instbase/htdocs";
open TESTCONF, "< $conffile"
or die "Could not open config file $conffile: $!";
while (<TESTCONF>) {
index ba_when(when_at),
index ba_what(facility, component, module, function)
);
+
+-- a more generic file container
+-- any future managed files belong here
+drop table if exists bse_files;
+create table bse_files (
+ id integer not null auto_increment primary key,
+
+ -- type of file, used to lookup a behaviour class
+ file_type varchar(20) not null,
+
+ -- id of the owner
+ owner_id integer not null,
+
+ -- name stored as
+ filename varchar(255) not null,
+
+ -- name displayed as
+ display_name varchar(255) not null,
+
+ content_type varchar(255) not null,
+
+ size_in_bytes integer not null,
+
+ when_uploaded datetime not null,
+
+ -- is the file public?
+ is_public integer not null,
+
+ -- name identifier for the file (where needed)
+ name varchar(80) null,
+
+ -- ordering
+ display_order integer not null,
+
+ -- where a user finds the file
+ src varchar(255) not null,
+
+ -- categories within a type
+ category varchar(255) not null default '',
+
+ -- for use with images
+ alt varchar(255) null,
+ width integer null,
+ height integer null,
+ url varchar(255) null,
+
+ description text not null,
+
+ index owner(file_type, owner_id)
+);
\ No newline at end of file
; url should not include a trailing /
url=http://your.site.base
secureurl=$(url)
+public_files=/managed_assets/
[basic]
randomdata = /dev/urandom
siteuser_images = $(paths/downloads)
dynamic_cache=$(paths/downloads)/../cache
backgroundlogs=$(downloads)/../backlogs
+public_files=$(public_html)/managed_assets
[pregenerate]
--- /dev/null
+package BSE::FileBehaviour;
+use strict;
+
+our $VERSION = "1.000";
+
+sub new {
+ my ($class, %opts) = @_;
+
+ return bless \%opts, $class;
+}
+
+sub owner_id {
+ my ($self, $owner) = @_;
+
+ exists $self->{unowned}
+ and return -1;
+
+ return $owner->id;
+}
+
+sub unowned {
+ my ($self) = @_;
+
+ return $self->{unowned};
+}
+
+sub file_type {
+ my ($self) = @_;
+
+ # should have been passed to new()
+ return $self->{file_type};
+}
+
+sub start_public {
+ my ($self) = @_;
+
+ # should have been passed to new()
+ return $self->{public};
+}
+
+sub validate {
+ return 1;
+}
+
+my %image_types =
+ (
+ GIF => "image/gif",
+ JPG => "image/jpeg",
+ XBM => "image/x-xbitmap",
+ XPM => "image/x-xpm",
+ PPM => "image/x-portable-anymap",
+ PNG => "image/png",
+ MNG => "video/x-mng",
+ TIF => "image/tiff",
+ BMP => "image/bmp",
+ PSD => "image/x-psd",
+ SWF => "application/x-shockwave-flash",
+ CWS => "application/x-shockwave-flash",
+ PCD => "image/pcd",
+ );
+
+sub populate {
+ my ($self, $attr, $path) = @_;
+
+ require Image::Size;
+ my ($width, $height, $type) = Image::Size::imgsize($path);
+ if ($width) {
+ $attr->{width} = $width;
+ $attr->{height} = $height;
+ $attr->{content_type} = $image_types{$type} || "application/octet-stream";
+ }
+ else {
+ require BSE::Util::ContentType;
+ $attr->{content_type} = BSE::Util::ContentType::content_type(BSE::Cfg->single, $attr->{display_name});
+ }
+
+ return 1;
+}
+
+package BSE::FileBehaviour::Image;
+use strict;
+
+our @ISA = qw(BSE::FileBehaviour);
+
+sub validate {
+ my ($self, $attr, $rerror, $owner) = @_;
+
+ unless ($attr->{content_type} =~ m(^image/)) {
+ $$rerror = $self->image_file_message;
+ return;
+ }
+
+ return 1;
+}
+
+sub image_file_message {
+ my ($self) = @_;
+
+ return $self->{image_file_message} || "msg:bse/files/image_file_required";
+}
+
+1;
+
+=head1 HEAD
+
+BSE::FileBehaviour - abstract base class for defining BSE::TB::File behaviour
+
+=head1 DESCRIPTION
+
+The following methods must be defined:
+
+=over
+
+=item *
+
+file_url($file) - return a non-public URL to the file.
+
+=item *
+
+file_type - value to use for the file_type of files of this type
+
+=item *
+
+owner_id($owner) - used to extract the id of the owner object. A
+default implementation returns C<< $owner->id >>.
+
+=item *
+
+validate(\%object, \$error, $owner) - called to validate that the
+file meets the needs of the owner. A default implementation returns
+true.
+
+=back
+
+=cut
# automatically generated
-our $hash = "18495aa7dfec14fdae3a2d9291e7d301";
+our $hash = "d7720fb7401aa74924c5dc7acdf1f3b3";
our %versions =
(
"BSE::EmailBlacklist" => "1.000",
"BSE::EmailRequest" => "1.000",
"BSE::EmailRequests" => "1.000",
+ "BSE::FileBehaviour" => "1.000",
"BSE::FileHandler::Base" => "1.000",
"BSE::FileHandler::Default" => "1.000",
"BSE::FileHandler::FLV" => "1.000",
"BSE::TB::ArticleFileMetas" => "1.000",
"BSE::TB::ArticleFiles" => "1.000",
"BSE::TB::AuditEntry" => "1.002",
- "BSE::TB::AuditLog" => "1.001",
+ "BSE::TB::AuditLog" => "1.002",
"BSE::TB::BackgroundTask" => "1.000",
"BSE::TB::BackgroundTasks" => "1.000",
+ "BSE::TB::File" => "1.000",
"BSE::TB::FileAccessLog" => "1.000",
"BSE::TB::FileAccessLogEntry" => "1.000",
+ "BSE::TB::Files" => "1.000",
"BSE::TB::Image" => "1.001",
"BSE::TB::Images" => "1.000",
"BSE::TB::Location" => "1.001",
"BSE::Thumb::Imager::Colourize" => "1.000",
"BSE::Thumb::Imager::RandomCrop" => "1.000",
"BSE::ThumbLow" => "1.000",
+ "BSE::UI" => "1.000",
"BSE::UI::API" => "1.000",
"BSE::UI::AdminAudit" => "1.000",
"BSE::UI::AdminDispatch" => "1.000",
use BSE::TB::AuditEntry;
use Scalar::Util qw(blessed);
-our $VERSION = "1.001";
+our $VERSION = "1.002";
sub rowClass {
return 'BSE::TB::AuditEntry';
}
+# stop us recursing into here from BSE::ComposeMail
+my $mailing = 0;
+
=item log
Log a message to the audit log.
}
require BSE::TB::AuditLog;
- BSE::TB::AuditLog->make(%entry);
+ my $entry = BSE::TB::AuditLog->make(%entry);
+
+ if ($cfg->entry("mail audit log", $level_name)
+ && !$mailing) {
+ $mailing = 1;
+ eval {
+ require BSE::ComposeMail;
+ my $to = $cfg->entry("mail audit log", "to",
+ $cfg->entry("shop", "from"));
+ if ($to) {
+ require BSE::Util::Tags;
+ my $mailer = BSE::ComposeMail->new(cfg => $cfg);
+ my %acts =
+ (
+ BSE::Util::Tags->static(undef, $cfg),
+ entry => [ \&BSE::Util::Tags::tag_object, $entry ],
+ );
+ $mailer->send(to => $to,
+ subject => "BSE System Error",
+ template => "admin/log/mail",
+ acts => \%acts);
+ }
+ };
+ $mailing = 0;
+ }
+
keys %opts
and $class->crash("Unknown parameters ", join(",", keys %opts), " to log()");
}
--- /dev/null
+package BSE::TB::File;
+use strict;
+use Squirrel::Row;
+use vars qw/@ISA/;
+@ISA = qw/Squirrel::Row/;
+use Carp 'confess';
+
+our $VERSION = "1.000";
+
+sub columns {
+ return qw/id file_type owner_id filename display_name content_type
+ size_in_bytes is_public name display_order src category
+ alt width height url description/;
+}
+
+sub table {
+ "bse_files";
+}
+
+my $display_order = time;
+sub defaults {
+ require BSE::Util::SQL;
+ return
+ (
+ when_uploaded => BSE::Util::SQL::now_datetime(),
+ is_public => 0,
+ name => '',
+ display_order => $display_order++,
+ src => '',
+ category => '',
+ alt => '',
+ width => 0,
+ height => 0,
+ url => '',
+ );
+}
+
+sub full_filename {
+ my ($self) = @_;
+
+ $self->is_public ? $self->public_filename : $self->private_filename;
+}
+
+sub private_filename {
+ my ($self) = @_;
+
+ my $downloadPath = BSE::TB::Files->private_path;
+ return $downloadPath . "/" . $self->filename;
+}
+
+sub public_filename {
+ my ($self) = @_;
+
+ my $downloadPath = BSE::TB::Files->public_path;
+ return $downloadPath . "/" . $self->filename;
+}
+
+sub remove {
+ my ($self) = @_;
+
+ my $filename = $self->full_filename;
+ my $debug_del = BSE::Cfg->single->entryBool('debug', 'file_unlink', 0);
+ if ($debug_del) {
+ unlink $filename
+ or print STDERR "Error deleting $filename: $!\n";
+ }
+ else {
+ unlink $filename;
+ }
+
+ $self->SUPER::remove();
+}
+
+sub url {
+ my ($self) = @_;
+
+ if ($self->is_public) {
+ return $self->public_url;
+ }
+ else {
+ return $self->file_behaviour->file_url($self);
+ }
+}
+
+sub public_url {
+ my ($self) = @_;
+
+ return BSE::TB::Files->public_base_url() . $self->filename;
+}
+
+my %behaviours;
+
+sub file_behaviour {
+ my ($self) = @_;
+
+ my $behaviour = $behaviours{$self->owner_type};
+
+ unless ($behaviour) {
+ my ($cfg) = BSE::Cfg->single->entry("file behaviour", $self->owner_type);
+ my ($class, $load, $method) = split /,/, $cfg;
+ $load ||= $class;
+ $method ||= "new";
+
+ $load =~ s(::)(/)g;
+ $load .= ".pm" unless $load =~ /\.pm$/;
+
+ require $load;
+
+ $behaviour = $class->$method;
+ $behaviours{$class->owner_type} = $behaviour;
+ }
+
+ return $behaviour;
+}
+
+sub json_data {
+ my ($self) = @_;
+
+ my $data = $self->data_only;
+
+ return $data;
+}
+
+1;
--- /dev/null
+package BSE::TB::Files;
+use strict;
+use Squirrel::Table;
+use vars qw(@ISA $VERSION);
+@ISA = qw(Squirrel::Table);
+use BSE::TB::File;
+use Carp ();
+
+our $VERSION = "1.000";
+
+sub rowClass {
+ return 'BSE::TB::File';
+}
+
+sub private_path {
+ my ($class) = @_;
+
+ return BSE::Cfg->single->entryVar('paths', 'downloads');
+}
+
+sub public_path {
+ my ($class) = @_;
+
+ return BSE::Cfg->single->entryVar('paths', 'public_files');
+}
+
+sub public_base_url {
+ my ($class) = @_;
+
+ return BSE::Cfg->single->entryVar('site', 'public_files');
+}
+
+sub make_filename {
+ my ($class, $basename, $public, $rmsg) = @_;
+
+ my $base_path = $public ? $class->public_path : $class->private_path;
+ require DevHelp::FileUpload;
+ my ($file_name, $out_fh) = DevHelp::FileUpload->
+ make_img_filename($base_path, $basename, $rmsg)
+ or return;
+
+ return ($file_name, $out_fh, "$base_path/$file_name");
+}
+
+sub add_cgi_file {
+ my ($class, %opts) = @_;
+
+ my $req = delete $opts{req}
+ or Carp::confess "No req parameter";
+ my $behaviour = delete $opts{behaviour}
+ or Carp::confess "No behaviour parameter";
+ my $name = delete $opts{name}
+ or Carp::confess "No name parameter";
+ my $owner;
+ unless ($behaviour->unonwned) {
+ $owner = delete $opts{owner}
+ or Carp::confess "No owner parameter";
+ }
+ my $errors = delete $opts{errors}
+ or Carp::confess "No errors parameter";
+ my $required = delete $opts{required} || 0;
+
+ my $cgi = $req->cgi;
+ my $file_key = $name . "_file";
+ my $file_name = $cgi->param($file_key);
+ my $file_fh = $cgi->upload($file_key);
+ if ($file_name) {
+ unless ($file_fh
+ && $ENV{CONTENT_TYPE} =~ m(^multipart/form-data)) {
+ $errors->{$file_key} = "Files can only be uploaded as multipart/form-data - check the form enctype";
+ return;
+ }
+ if (-z $file_name) {
+ $errors->{$file_key} = "File $file_name is empty";
+ return;
+ }
+ }
+ else {
+ $required
+ and $errors->{$file_key} = "No file specified";
+ return;
+ }
+
+ my $public = $behaviour->start_public;
+
+ my $msg;
+ my ($out_name, $out_fh, $full_path) =
+ BSE::TB::Files->make_filename($file_name, $public, \$msg);
+ unless ($out_name) {
+ $errors->{$file_key} = $msg;
+ return;
+ }
+ local $/ = \16384;
+ binmode $file_fh;
+ binmode $out_fh;
+ my $size = 0;
+ while (<$file_fh>) {
+ print $out_fh $_;
+ $size += length;
+ }
+ unless (close $out_fh) {
+ $errors->{$file_key} = "Cannot close saved file: $!";
+ unlink $full_path;
+ return;
+ }
+
+ my %file;
+ $file{display_name} = $file_name;
+ $file{filename} = $out_name;
+ $file{size_in_bytes} = $size;
+ $file{file_type} = $behaviour->file_type;
+ $file{owner_id} = $owner->id;
+ $file{is_public} = $public;
+
+ for my $field (qw/alt url description category name/) {
+ my $value = $cgi->param($name . "_" . $field);
+ defined $value or $value = "";
+ $file{$field} = $value;
+ }
+
+ $behaviour->populate(\%file, $full_path);
+ my $error;
+ unless ($behaviour->validate(\%file, \$error, $owner)) {
+ $errors->{$file_key} = $error;
+ unlink($full_path);
+ return;
+ }
+
+ my $file = BSE::TB::Files->make(%file);
+ $file->set_src($file->url);
+ $file->save;
+
+ return $file;
+}
+
+sub save_cgi_file {
+ my ($self, %opts) = @_;
+
+ my $req = delete $opts{req}
+ or Carp::confess "No req parameter";
+ my $behaviour = delete $opts{behaviour}
+ or Carp::confess "No behaviour parameter";
+ my $name = delete $opts{name}
+ or Carp::confess "No name parameter";
+ my $owner;
+ unless ($behaviour->unowned) {
+ $owner = delete $opts{owner}
+ or Carp::confess "No owner parameter";
+ }
+ my $errors = delete $opts{errors}
+ or Carp::confess "No errors parameter";
+ my $file = delete $opts{file};
+ my $old_files = delete $opts{old_files}
+ or Carp::confess "No old_files parameter";
+ my $new_files = delete $opts{new_files}
+ or Carp::confess "No new_files parameter";
+
+ my $cgi = $req->cgi;
+ my $file_key = $name . "_file";
+ my $file_name = $cgi->param($file_key);
+ my $file_fh = $cgi->upload($file_key);
+ if ($file_name) {
+ unless ($file_fh
+ && $ENV{CONTENT_TYPE} =~ m(^multipart/form-data)) {
+ $errors->{$file_key} = "Files can only be uploaded as multipart/form-data - check the form enctype";
+ return;
+ }
+ if (-z $file_name) {
+ $errors->{$file_key} = "File $file_name is empty";
+ return;
+ }
+
+ my $msg;
+ my ($out_name, $out_fh, $full_path) =
+ BSE::TB::Files->make_filename($file_name, $file->is_public, \$msg);
+ unless ($out_name) {
+ $errors->{$file_key} = $msg;
+ return;
+ }
+ local $/ = \16384;
+ binmode $file_fh;
+ binmode $out_fh;
+ my $size = 0;
+ while (<$file_fh>) {
+ print $out_fh $_;
+ $size += length;
+ }
+ unless (close $out_fh) {
+ $errors->{$file_key} = "Cannot close saved file: $!";
+ unlink $full_path;
+ return;
+ }
+
+ push @$old_files, $file->full_filename;
+ push @$new_files, $full_path;
+ $file->set_filename($out_name);
+ $file->set_display_name($file_name . "");
+ $file->set_size_in_bytes($size);
+
+ $behaviour->populate($file, $full_path);
+ my $error;
+ unless ($behaviour->validate($file, \$error, $owner)) {
+ $errors->{$file_key} = $error;
+ return;
+ }
+ $file->set_src($file->url);
+ }
+
+ for my $field (qw/alt url description category name/) {
+ my $value = $cgi->param($name . "_" . $field);
+ defined $value or $value = "";
+ $file->set($field => $value);
+ }
+
+ return $file;
+}
+
+1;
--- /dev/null
+package BSE::UI;
+use strict;
+use BSE::Cfg;
+
+our $VERSION = "1.000";
+
+sub confess;
+
+sub run {
+ my ($class, $ui_class, %opts) = @_;
+
+ local $SIG{__DIE__} = sub { confess @_ };
+ (my $file = $ui_class . ".pm") =~ s(::)(/)g;
+
+ my $cfg = $opts{cfg} || BSE::Cfg->new;
+
+ my $req;
+ eval {
+ require BSE::Request;
+ $req = BSE::Request->new
+ (
+ cfg => $cfg,
+ %{$opts{req_params} || {}},
+ );
+ 1;
+ } or fail("Loading request class: $@", "req", $cfg);
+
+ eval {
+ require $file;
+ 1;
+ } or fail("Loading module $file: $@", "load", $cfg);
+
+ eval {
+ my $ui = $ui_class->new;
+ my $result = $ui->dispatch($req);
+
+ if (!$result && !$opts{silent_exit}) {
+ confess "No content returned by dispatch()";
+ }
+
+ my $cfg = $req->cfg;
+ undef $req; # release any locks
+ if ($result) {
+ require BSE::Template;
+ BSE::Template->output_resultc($cfg, $result);
+ }
+
+ 1;
+ } or fail("Running dispatcher: $@", "run", $cfg);
+}
+
+sub run_fcgi {
+ my ($class, $ui_class, %opts) = @_;
+
+ local $SIG{__DIE__} = sub { confess @_ };
+ (my $file = $ui_class . ".pm") =~ s(::)(/)g;
+
+ my $cfg = $opts{cfg} || BSE::Cfg->new;
+
+ eval {
+ require $file;
+ 1;
+ } or fail("Loading module $file: $@", "load", $cfg);
+
+ while (my $cgi = CGI::Fast->new) {
+ my $req;
+ eval {
+ require BSE::Request;
+ $req = BSE::Request->new
+ (
+ cfg => $cfg,
+ cgi => $cgi,
+ fastcgi => $FCGI::global_request->IsFastCGI
+ %{$opts{req_params} || {}},
+ );
+ 1;
+ } or fail("Loading request class: $@", "req", $cfg);
+
+ eval {
+ my $ui = $ui_class->new;
+ my $result = $ui->dispatch($req);
+
+ if (!$result && !$opts{silent_exit}) {
+ confess "No content returned by dispatch()";
+ }
+
+ my $cfg = $req->cfg;
+ undef $req; # release any locks
+ if ($result) {
+ require BSE::Template;
+ BSE::Template->output_resultc($cfg, $result);
+ }
+
+ 1;
+ } or fail("Running dispatcher: $@", "run", $cfg);
+ }
+}
+
+sub confess {
+ require Carp;
+
+ goto &Carp::confess;
+}
+
+sub fail {
+ my ($msg, $func, $cfg) = @_;
+
+ print STDERR "run failure: $msg\n";
+ eval {
+ # try to log it
+ require BSE::TB::AuditLog;
+ my ($script) = $ENV{SCRIPT_NAME} =~ /(\w+)\.\w+$/;
+ $script ||= "unknown";
+ BSE::TB::AuditLog->log
+ (
+ component => "$script:run",
+ function => $func,
+ level => "crit",
+ actor => "S",
+ msg => $msg,
+ dump => <<DUMP,
+Error: $msg
+
+\@INC: @INC
+DUMP
+ );
+ 1;
+ } or print STDERR "Could not log: $@\n";
+
+ print <<EOS;
+Status: 500
+Content-Type: text/plain
+
+There was an error producing your content.
+EOS
+ exit 1;
+}
+
+1;
initialize: function(parameters) {
if (!parameters) parameters = {};
this.initialized = true;
- this.onException = function(obj, e) {
+ this.onException = function(e) {
alert(e);
};
this.onFailure = function(error) { alert(error.message); };
--- /dev/null
+An error occurred on <:cfg site url:>
+
+Level: <:entry level_name:>
+When: <:date "%H:%M %d/%m/%Y" entry when_at:>
+
+Message:
+<:entry msg |z:>
Column category;varchar(20);NO;NULL;
Index by_category;0;[category]
Index by_siteuser;0;[siteuser_id]
+Table bse_files
+Column id;int(11);NO;NULL;auto_increment
+Column file_type;varchar(20);NO;NULL;
+Column owner_id;int(11);NO;NULL;
+Column filename;varchar(255);NO;NULL;
+Column display_name;varchar(255);NO;NULL;
+Column content_type;varchar(255);NO;NULL;
+Column size_in_bytes;int(11);NO;NULL;
+Column when_uploaded;datetime;NO;NULL;
+Column is_public;int(11);NO;NULL;
+Column name;varchar(80);YES;NULL;
+Column display_order;int(11);NO;NULL;
+Column src;varchar(255);NO;NULL;
+Column category;varchar(255);NO;;
+Column alt;varchar(255);YES;NULL;
+Column width;int(11);YES;NULL;
+Column height;int(11);YES;NULL;
+Column url;varchar(255);YES;NULL;
+Column description;text;NO;NULL;
+Index PRIMARY;1;[id]
+Index owner;0;[file_type;owner_id]
Table bse_locations
Column id;int(11);NO;NULL;auto_increment
Column description;varchar(255);NO;NULL;
projects / bse.git / commitdiff