site/cgi-bin/admin/admin.pl
site/cgi-bin/admin/admin_seminar.pl
site/cgi-bin/admin/adminusers.pl
+site/cgi-bin/admin/backmon.pl
site/cgi-bin/admin/bse_timeout.pl
site/cgi-bin/admin/bse_modules.pl
site/cgi-bin/admin/changepw.pl
site/cgi-bin/modules/BSE/TB/AdminPerms.pm
site/cgi-bin/modules/BSE/TB/AdminUser.pm
site/cgi-bin/modules/BSE/TB/AdminUsers.pm
+site/cgi-bin/modules/BSE/TB/BackgroundTask.pm
+site/cgi-bin/modules/BSE/TB/BackgroundTasks.pm
site/cgi-bin/modules/BSE/TB/FileAccessLog.pm
site/cgi-bin/modules/BSE/TB/FileAccessLogEntry.pm
site/cgi-bin/modules/BSE/TB/Location.pm
site/cgi-bin/modules/BSE/Thumb/Imager.pm
site/cgi-bin/modules/BSE/Thumb/Imager/RandomCrop.pm
site/cgi-bin/modules/BSE/ThumbLow.pm
+site/cgi-bin/modules/BSE/UI/Background.pm
site/cgi-bin/modules/BSE/UI/AdminDispatch.pm
site/cgi-bin/modules/BSE/UI/AdminNewsletter.pm
site/cgi-bin/modules/BSE/UI/AdminReport.pm
site/cgi-bin/thumb.pl
site/cgi-bin/user.pl
site/data/stopwords.txt
-site/data/db/sql_statements.pkey
+site/data/db/bse_background_tasks.data
+site/data/db/bse_background_tasks.pkey
site/data/db/sql_statements.data
+site/data/db/sql_statements.pkey
site/docs/BSE::UI::Affiliate.html
site/docs/Generate.html
site/docs/Generate::Article.html
site/templates/admin/adduser.tmpl
# site/templates/admin/article_custom.tmpl
site/templates/admin/article_img.tmpl
+site/templates/admin/back/detail.tmpl
+site/templates/admin/back/list.tmpl
site/templates/admin/base.tmpl
site/templates/admin/catalog.tmpl # embedded in the shopadmin catalog/product display
# site/templates/admin/catalog_custom.tmpl
# site/templates/admin/edit_4.tmpl
# site/templates/admin/edit_5.tmpl
site/templates/admin/edit_catalog.tmpl
-site/templates/admin/edit_dragdrop.tmpl
+#site/templates/admin/edit_dragdrop.tmpl
site/templates/admin/edit_groups.tmpl
-site/templates/admin/edit_kidsof.tmpl
+$#ite/templates/admin/edit_kidsof.tmpl
site/templates/admin/edit_prodopts.tmpl
site/templates/admin/edit_product.tmpl
site/templates/admin/edit_seminar.tmpl
site/templates/user/userpage_base.tmpl
site/templates/xbase.tmpl
site/util/bseaddimages.pl
+site/util/bse_back.pl
site/util/bse_notify_files.pl
site/util/bse_s3.pl
site/util/bse_storage.pl
index by_file(file_id),
index by_user(siteuser_id, when_at)
);
+
+-- configuration of background tasks
+drop table if exists bse_background_tasks;
+create table bse_background_tasks (
+ -- static, doesn't change at runtime
+ -- string id of the task
+ id varchar(20) not null primary key,
+
+ -- description suitable for users
+ description varchar(80) not null,
+
+ -- module that implements the task, or
+ modname varchar(80) not null default '',
+
+ -- binary (relative to base) that implements the task and options
+ binname varchar(80) not null default '',
+ bin_opts varchar(255) not null default '',
+
+ -- whether the task can be stopped
+ stoppable integer not null default 0,
+
+ -- bse right required to start it
+ start_right varchar(40),
+
+ -- dynamic, changes over time
+ -- non-zero if running
+ running integer not null default 0,
+
+ -- pid of the task
+ task_pid integer null,
+
+ -- last exit code
+ last_exit integer null,
+
+ -- last time started
+ last_started datetime null,
+
+ -- last completion time
+ last_completion datetime null
+);
--- /dev/null
+#!/usr/bin/perl -w
+# -d:ptkdb
+BEGIN { $ENV{DISPLAY} = '192.168.32.51:0.0' }
+use strict;
+use FindBin;
+use lib "$FindBin::Bin/../modules";
+use BSE::DB;
+use BSE::Request;
+use BSE::Template;
+use Carp 'confess';
+use BSE::UI::Background;
+
+$SIG{__DIE__} = sub { confess $@ };
+
+my $req = BSE::Request->new;
+
+my $result = BSE::UI::Background->dispatch($req);
+$req->output_result($result);
downloads = /somewhere
siteuser_images = $(paths/downloads)
dynamic_cache=$(paths/downloads)/../cache
+backgroundlogs=$(downloads)/../backlogs
[pregenerate]
$_[0]{dbh};
}
+sub forked {
+ my $self = shift;
+
+ $self = BSE::DB->single unless ref $self;
+
+ $self->_forked;
+}
+
sub _query_expr {
my ($args, $map, $table_name, $op, @terms) = @_;
$self;
}
+sub _forked {
+ my $self = shift;
+
+ $self->{dbh}{InactiveDestroy} = 1;
+ delete $self->{dbh};
+ $self->{dbh} = $self->_connect;
+}
+
+
my $get_sql_by_name = 'select sql_statement from sql_statements where name=?';
sub stmt_sql {
--- /dev/null
+package BSE::TB::BackgroundTask;
+use strict;
+use base 'Squirrel::Row';
+use BSE::Util::SQL qw(now_sqldatetime);
+use Carp qw(confess);
+use Errno qw(EPERM EACCES);
+
+sub columns {
+ return qw/id description modname binname bin_opts stoppable start_right running task_pid last_exit last_started last_completion/;
+}
+
+sub table {
+ "bse_background_tasks";
+}
+
+sub logfilename {
+ my ($self, $cfg) = @_;
+
+ my $base_path = $cfg->entryVar("paths", "backgroundlogs");
+ return $base_path . "/" . $self->id . ".log";
+}
+
+sub _find_script {
+ my ($cfg, $binname) = @_;
+
+ if ($binname =~ m!^/!) {
+ -f $binname
+ or return;
+
+ return $binname;
+ }
+
+ use File::Spec;
+ my @relpath;
+ my $filename = join("/", @relpath, $binname);
+ while (!-f $filename && @relpath < 10) {
+ push @relpath, "..";
+ $filename = join("/", @relpath, $binname);
+ }
+
+ -f $filename
+ or return;
+
+ return File::Spec->rel2abs($filename);
+}
+
+sub start {
+ my ($self, %opts) = @_;
+
+ my $cfg = delete $opts{cfg};
+ my $msg = delete $opts{msg};
+
+ # find the binary
+ my $binname = $self->binname;
+ my @args = split ' ', $self->bin_opts;
+ if ($binname =~ s/^perl //) {
+ my $script = _find_script($cfg, $binname);
+ unless ($script) {
+ $$msg = "Cannot find script $binname";
+ return;
+ }
+ $binname = $^X;
+ unshift @args, $script;
+ }
+ else {
+ my $foundname = _find_script($cfg, $binname);
+ unless ($foundname) {
+ $$msg = "Cannot find binary $binname";
+ return;
+ }
+ $binname = $foundname;
+ }
+
+ require POSIX;
+ my $logfilename = $self->logfilename($cfg);
+ require IO::File;
+ my $outfh = IO::File->new($logfilename, "w");
+ if (!$outfh && ($! == EACCES || $! == EPERM)) {
+ unlink $logfilename;
+ $outfh = IO::File->new($logfilename, "w");
+ }
+
+ unless ($outfh) {
+ $$msg = "Cannot open logfile $logfilename: $!";
+ return;
+ }
+
+ my $pid = fork;
+ unless (defined $pid) {
+ $$msg = "Could not fork: $!";
+ return;
+ }
+ my $task_id = $self->id;
+ if ($pid) {
+ # parent process
+ $self->set_task_pid($pid);
+ $self->set_running(1);
+ $self->set_last_started(now_sqldatetime());
+ $self->save;
+
+ return $pid;
+ }
+ else {
+ BSE::DB->forked;
+
+ # child process
+ my $null = $^O eq 'MSWin32' ? "NUL" : "/dev/null";
+ untie *STDIN;
+ open STDIN, "<$null"
+ or die "Cannot open $null: $!";
+ untie *STDOUT;
+ open STDOUT, ">&".fileno($outfh)
+ or die "Cannot redirect stdout: $!";
+ untie *STDERR;
+ open STDERR, ">&STDOUT" or die "Cannot redirect STDOUT: $!";
+ POSIX::setsid();
+
+ my $pid2 = fork;
+ unless (defined $pid) {
+ print STDERR "Cannot start second child: $!\n";
+ $self->set_running(0);
+ $self->set_task_pid(undef);
+ $self->save;
+ exit;
+ }
+
+ if ($pid2) {
+ waitpid $pid2, 0;
+ if ($?) {
+ print STDERR "Task exited with non-zero-status: $?\n";
+ }
+ # this can happen hours or minutes after the original task changes
+ # and it's in a different process too
+ my $task = BSE::TB::BackgroundTasks->getByPkey($task_id);
+ $task->set_running(0);
+ $task->set_task_pid(undef);
+ $task->set_last_exit($?);
+ $task->set_last_completion(now_sqldatetime());
+ $task->save;
+ exit;
+ }
+ else {
+ BSE::DB->forked;
+ { exec $binname, @args; } # suppress warning
+ print STDERR "Exec of $binname failed: $!\n";
+ exit 1;
+ }
+ }
+}
+
+sub check_running {
+ my ($self) = @_;
+
+ if ($self->running) {
+ if ($self->task_pid) {
+ # check if it's running
+ if (!kill(0, $self->task_pid)
+ && !$!{EPERM}) {
+ return 0;
+ }
+ }
+ }
+
+ return $self->running;
+}
+
+1;
--- /dev/null
+package BSE::TB::BackgroundTasks;
+use strict;
+use base 'Squirrel::Table';
+use BSE::TB::BackgroundTask;
+
+sub rowClass {
+ 'BSE::TB::BackgroundTask';
+}
+
+1;
use strict;
use base 'Squirrel::Row';
use BSE::Util::SQL qw(now_sqldatetime);
+use Carp qw(confess);
sub columns {
return qw/id owner_type owner_id category filename display_name content_type download title body modwhen size_in_bytes/;
);
}
+sub download_result {
+ my ($self, %opts) = @_;
+
+ my $download = delete $opts{download} || $self->download;
+ my $cfg = delete $opts{cfg} or confess "Missing cfg parameter";
+ my $rmsg = delete $opts{msg} or confess "Missing msg parameter";
+ my $user = delete $opts{user};
+
+ my $filebase = $cfg->entryVar('paths', 'downloads');
+ require IO::File;
+ my $fh = IO::File->new("$filebase/" . $self->filename, "r");
+ unless ($fh) {
+ $$rmsg = "Cannot open stored file: $!";
+ return;
+ }
+
+ my @headers;
+ my %result =
+ (
+ content_fh => $fh,
+ headers => \@headers,
+ );
+ if ($download) {
+ push @headers, "Content-Disposition: attachment; filename=".$self->display_name;
+ $result{type} = "application/octet-stream";
+ }
+ else {
+ push @headers, "Content-Disposition: inline; filename=" . $self->display_name;
+ $result{type} = $self->content_type;
+ }
+ if ($cfg->entry("download", "log_downuload", 0) && $user) {
+ my $max_age = $cfg->entry("download", "log_downuload_maxage", 30);
+ BSE::DB->run(bseDownloadLogAge => $max_age);
+ require BSE::TB::FileAccessLog;
+ BSE::TB::FileAccessLog->log_download
+ (
+ user => $user,
+ file => $self,
+ download => $download,
+ );
+ }
+
+ return \%result;
+}
+
1;
--- /dev/null
+package BSE::UI::Background;
+use strict;
+use base "BSE::UI::AdminDispatch";
+use BSE::TB::BackgroundTasks;
+use BSE::Util::Iterate;
+use BSE::Util::Tags;
+use BSE::Util::SQL qw(now_sqldatetime);
+use DevHelp::HTML;
+use IO::File;
+use BSE::Util::Tags qw(tag_hash);
+
+my %actions =
+ (
+ list => "",
+ start => "bse_back_start",
+ stop => "bse_back_stop",
+ detail => "bse_back_detail",
+ );
+
+sub actions { \%actions }
+
+sub rights { \%actions }
+
+sub default_action { "list" }
+
+sub req_list {
+ my ($self, $req, $errors) = @_;
+
+ my @all = BSE::TB::BackgroundTasks->all;
+ my $it = BSE::Util::Iterate->new;
+ my $message = $req->message($errors);
+ my $current_task;
+ my %acts =
+ (
+ BSE::Util::Tags->basic(undef, $req->cgi, $req->cfg),
+ BSE::Util::Tags->secure($req),
+ BSE::Util::Tags->admin(undef, $req->cfg),
+ $it->make
+ (
+ single => "task",
+ plural => "tasks",
+ data => \@all,
+ store => \$current_task,
+ ),
+ message => $message,
+ task_running => [ tag_task_running => $self, \$current_task ],
+ );
+
+ return $req->dyn_response("admin/back/list", \%acts);
+}
+
+sub tag_task_running {
+ my ($self, $rcurrent) = @_;
+
+ $$rcurrent or return '';
+
+ return $$rcurrent->check_running;
+}
+
+sub _get_task {
+ my ($req, $msg) = @_;
+
+ my $id = $req->cgi->param("id");
+ unless ($id) {
+ $$msg = "Missing id parameter";
+ return;
+ }
+
+ my $task = BSE::TB::BackgroundTasks->getByPkey($id);
+ unless ($task) {
+ $$msg = "Task not found";
+ return;
+ }
+
+ return $task;
+}
+
+sub req_start {
+ my ($self, $req) = @_;
+
+ my $msg;
+ my $task = _get_task($req, \$msg)
+ or return $self->req_list($req, { _ => $msg });
+
+ $task->check_running
+ and return $self->req_list($req, { _ => $task->description . " is already running" });
+
+ my $pid = $task->start
+ (
+ cfg => $req->cfg,
+ msg => \$msg,
+ );
+ if ($pid) {
+ return BSE::Template->get_refresh("$ENV{SCRIPT_NAME}?m=Started+".escape_uri($task->description), $req->cfg);
+ }
+ else {
+ return $self->req_list($req, { _ => $msg });
+ }
+}
+
+sub req_detail {
+ my ($self, $req) = @_;
+
+ my $msg;
+ my $task = _get_task($req, \$msg)
+ or return $self->req_list($req, { _ => $msg });
+
+ my $logfilename = $task->logfilename($req->cfg);
+ my $logtext = '';
+ if (-f $logfilename) {
+ my $fh = IO::File->new($logfilename, "r");
+ if ($fh) {
+ local $/;
+ $logtext = <$fh>;
+ }
+ }
+ my %acts =
+ (
+ BSE::Util::Tags->basic(undef, $req->cgi, $req->cfg),
+ BSE::Util::Tags->secure($req),
+ BSE::Util::Tags->admin(undef, $req->cfg),
+ task => [ \&tag_hash, $task ],
+ task_running => scalar($task->check_running),
+ log => escape_html($logtext),
+ );
+
+ return $req->dyn_response("admin/back/detail", \%acts);
+}
+
+1;
$accessible
or return $self->error($req, "Sorry, you don't have access to this file");
- my $filebase = $cfg->entryVar('paths', 'downloads');
- require IO::File;
- my $fh = IO::File->new("$filebase/" . $file->filename, "r")
- or return $self->error($req, "Cannot open stored file: $!");
-
- my @headers;
- my %result =
+ my $msg;
+ my $result = $file->download_result
(
- content_fh => $fh,
- headers => \@headers,
- );
- my $download = $cgi->param("force_download") || $file->download;
- if ($download) {
- push @headers, "Content-Disposition: attachment; filename=".$file->display_name;
- $result{type} = "application/octet-stream";
- }
- else {
- push @headers, "Content-Disposition: inline; filename=" . $file->display_name;
- $result{type} = $file->content_type;
- }
- if ($cfg->entry("download", "log_downuload", 0)) {
- my $max_age = $cfg->entry("download", "log_downuload_maxage", 30);
- BSE::DB->run(bseDownloadLogAge => $max_age);
- require BSE::TB::FileAccessLog;
- BSE::TB::FileAccessLog->log_download
- (
- user => $user,
- file => $file,
- download => $download,
- );
- }
+ cfg => $req->cfg,
+ download => scalar($cgi->param("force_download")),
+ msg => \$msg,
+ user => $user,
+ )
+ or return $self->error($req, $msg);
- BSE::Template->output_result($req, \%result);
+ BSE::Template->output_result($req, $result);
}
1;
my $result = eval $arg;
if ($@) {
+ print STDERR "code generated by arithmetic: >>$arg<<\n";
return escape_html("** arithmetic error ".$@." **");
}
--- /dev/null
+--
+id: gen
+description: Regenerate Site
+binname: perl util/gen.pl
+bin_opts: -v
+start_right: regen_all
+
where owner_type = 'U'
and owner_id = ?
SQL
+
+name: BackgroundTasks
+sql_statement: select * from bse_background_tasks
--- /dev/null
+<:wrap admin/xbase.tmpl title=>"Background task detail", showtitle => 1 :>
+<p>| <a href="/cgi-bin/admin/menu.pl">Admin Menu</a> |
+<a href="<:script:>">Task list</a> |
+<:if Task running:>
+<:ifTask stoppable:><a href="<:script:>?a_stop=1&id=<:task id:>">Stop</a> |<:or:><:eif:>
+
+<:or Task:>
+<a href="<:script:>?a_start=1&id=<:task id:>">Start</a> |
+<:eif Task:>
+</p>
+<table class="editform">
+<tr>
+ <th>Task</th>
+ <td><:task description:></td>
+</tr>
+<tr>
+ <th>Status</th>
+ <td><:ifTask_running:>Running (<:task task_pid:>)<:or:>Stopped<:eif:></td>
+</tr>
+<tr>
+ <th>Last Started</th>
+ <td><:task last_started:></td>
+</tr>
+<tr>
+ <th>Last Completed</th>
+ <td><:task last_completion:></td>
+</tr>
+<tr>
+ <th>Log:</th>
+ <td><textarea rows="20" class="wide"><:log:></textarea>
+</tr>
+</table>
\ No newline at end of file
--- /dev/null
+<:wrap admin/xbase.tmpl title=>"Background tasks", showtitle => 1 :>
+<:ifMessage:><p><:message:></p><:or:><:eif:>
+<table class="editform">
+<tr>
+ <th>Task</th>
+ <th>Status</th>
+ <th>Last Started</th>
+ <th>Last Completed</th>
+ <th>Completion Status</th>
+ <th>Admin</th>
+</tr>
+<:if Tasks:>
+<:iterator begin tasks:>
+<tr>
+ <td><:task description:></td>
+ <td><:ifTask running:>Running (<:task task_pid:>)<:or:>Stopped<:eif:></td>
+ <td><:task last_started:></td>
+ <td><:task last_completion:></td>
+ <td><:switch:><:case Eq [task last_exit] "":><:case task last_exit:>Failed<:case default:>Success<:endswitch:></td>
+ <td><:if Task_running:>
+<:ifTask stoppable:><a href="<:script:>?a_stop=1&id=<:task id:>">Stop</a><:or:><:eif:>
+
+<:or Task_running:>
+<a href="<:script:>?a_start=1&id=<:task id:>">Start</a>
+<:eif Task_running:>
+<a href="<:script:>?a_detail=1&id=<:task id:>">Details</a>
+</td>
+</tr>
+<:iterator end tasks:>
+<:or Tasks:>
+<tr>
+ <td colspan="3">No tasks available.</td>
+</tr>
+<:eif Tasks:>
+</table>
\ No newline at end of file
--- /dev/null
+#!/usr/bin/perl
+use strict;
+use warnings;
+use FindBin;
+use lib "$FindBin::Bin/../cgi-bin/modules";
+use BSE::Cfg;
+use BSE::TB::BackgroundTasks;
+
+{
+ chdir "$FindBin::Bin/../cgi-bin"
+ or warn "Could not change to cgi-bin directory: $!\n";
+
+ my $cfg = BSE::Cfg->new;
+
+ my $cmd = shift
+ or usage();
+
+ if ($cmd eq "start") {
+ do_start(\@ARGV, $cfg);
+ }
+ elsif ($cmd eq "status") {
+ do_status(\@ARGV, $cfg);
+ }
+ elsif ($cmd eq "running") {
+ do_running(\@ARGV, $cfg);
+ }
+ elsif ($cmd eq "ls" or $cmd eq "list") {
+ do_list(\@ARGV, $cfg);
+ }
+ else {
+ usage();
+ }
+
+ exit;
+}
+
+sub _get_task {
+ my ($args, $cmd) = @_;
+
+ my $task_id = shift @$args
+ or usage("start missing taskid parameter");
+ my $task = BSE::TB::BackgroundTasks->getByPkey($task_id)
+ or usage("Unknown taskid");
+
+ return $task;
+}
+
+sub do_start {
+ my ($args, $cfg) = @_;
+
+ my $task = _get_task($args);
+
+ $task->check_running
+ and die "Task ", $task->id, " is already running\n";
+
+ my $msg;
+ my $pid = $task->start
+ (
+ cfg => $cfg,
+ msg => \$msg,
+ );
+ $pid
+ or die "$msg\n";
+}
+
+sub do_status {
+ my ($args, $cfg) = @_;
+
+ my $task = _get_task($args);
+
+ print "Task Id: ", $task->id, "\n";
+ print "Description: ", $task->description, "\n";
+ print "Running: ", $task->check_running ? "Yes" : "No", "\n";
+ print "Last-Started: ", $task->last_started, "\n"
+ if $task->last_started;
+ print "Last-Completion: ", $task->last_completion, "\n"
+ if $task->last_completion;
+ print "Last-Exit: ", $task->last_exit, "\n"
+ if $task->last_exit;
+}
+
+sub do_running {
+ my ($args, $cfg) = @_;
+
+ my $task = _get_task($args);
+
+ exit $task->check_running ? 0 : 1;
+}
+
+sub do_list {
+ my ($args, $cfg) = @_;
+
+ for my $task (BSE::TB::BackgroundTasks->all) {
+ print $task->id, "\t",
+ $task->check_running ? "Yes" : "No", "\t",
+ $task->last_started || "", "\t",
+ $task->last_completion || "", "\t",
+ $task->last_exit || "", "\t",
+ $task->task_pid || "", "\n";
+ }
+}
+
+sub usage {
+ my $msg = shift;
+ $msg
+ and print STDERR "$msg\n";
+ die <<EOS;
+Usage: $0 <cmd> ...
+$0 start <taskid> - start the given task
+$0 status <taskid> - display status of the task
+$0 running <taskid> - test if running (for shell scripts)
+$0 ls
+$0 list - list all configured tasks
+EOS
+}
Column article_id;int(11);NO;NULL;
Column group_id;int(11);NO;NULL;
Index PRIMARY;1;[article_id;group_id]
+Table bse_background_tasks
+Column id;varchar(20);NO;NULL;
+Column description;varchar(80);NO;NULL;
+Column modname;varchar(80);NO;;
+Column binname;varchar(80);NO;;
+Column bin_opts;varchar(255);NO;;
+Column stoppable;int(11);NO;0;
+Column start_right;varchar(40);YES;NULL;
+Column running;int(11);NO;0;
+Column task_pid;int(11);YES;NULL;
+Column last_exit;int(11);YES;NULL;
+Column last_started;datetime;YES;NULL;
+Column last_completion;datetime;YES;NULL;
+Index PRIMARY;1;[id]
Table bse_file_access_log
Column id;int(11);NO;NULL;auto_increment
Column when_at;datetime;NO;NULL;
projects / bse.git / commitdiff