Skip to content

Commit

Permalink
Merge branch 'master' into session-as-object
Browse files Browse the repository at this point in the history 
Conflicts:
	inc/VegGuide/Build.pm
	lib/VegGuide/Config.pm
  • Loading branch information
@autarch
autarch committed Oct 19, 2011
2 parents 8828913 + 3c563c9 commit a4db1f2
Show file tree
Hide file tree
Showing 76 changed files with 1,136 additions and 543 deletions.
3 changes: 2 additions & 1 deletion .hgignore → .gitignore
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,3 @@
syntax: glob
.\#*
\#*\#
*~
Expand All @@ -8,6 +7,8 @@ Build
_build
MANIFEST
META.yml
MYMETA.yml
MYMETA.json
README
Debian_CPANTS.txt
Makefile.PL
Expand Down
57 changes: 44 additions & 13 deletions bin/vg-backup
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,27 +3,58 @@
use strict;
use warnings;

use Getopt::Long;
use VegGuide::Config;

exit 0
unless VegGuide::Config->IsProduction()
&& ! VegGuide::Config->IsTest();
&& !VegGuide::Config->IsTest();

my $verbose;
my @hosts;
my $dump = 1;

GetOptions(
'verbose' => \$verbose,
'host=s@' => \@hosts,
'dump!' => \$dump,
);

@hosts = qw( urth.org li205-70.members.linode.com )
unless @hosts;

# Should be run as me (autarch) on the vegguide.org box. No need to
# run as root.

if ($dump) {
print "Dumping database\n\n" if $verbose;

system( qw( mysqldump -u root RegVeg --ignore-table RegVeg.Session -r /home/autarch/RegVeg.sql ) )
and die 'Cannot execute mysqldump';
system(
qw( mysqldump -u root RegVeg --ignore-table RegVeg.Session -r /home/autarch/RegVeg.sql )
) and die 'Cannot execute mysqldump';
}

for my $source ( qw( /var/lib/vegguide/entry-images
/var/lib/vegguide/user-images
/var/lib/vegguide/skin-images
/home/autarch/RegVeg.sql
/var/lib/mailman/archives
/var/lib/mailman/lists ) )
{
system( 'rsync', '-e', 'ssh -i /home/autarch/.ssh/id_rsa.backups', '-r',
$source, 'urth.org:/home/autarch/backup/vegguide.org/' )
and die "Cannot rsync $source";
for my $host (@hosts) {
print "Rsyncing to $host\n\n";

for my $source (
qw( /var/lib/vegguide/entry-images
/var/lib/vegguide/user-images
/var/lib/vegguide/skin-images
/home/autarch/RegVeg.sql
/var/lib/mailman/archives
/var/lib/mailman/lists )
) {

my @v = $verbose ? '-v' : ();
system(
'rsync',
@v,
'-e', 'ssh -i /home/autarch/.ssh/id_rsa.backups',
'-r', '--links',
$source, $host . ':/home/autarch/backup/vegguide.org/'
) and die "Cannot rsync $source to $host";
}
}

print "vg-backup completed successfully\n\n";
20 changes: 20 additions & 0 deletions bin/vg-delete-old-sessions
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,20 @@
#!/usr/bin/perl

use strict;
use warnings;

use DateTime;
use Getopt::Long;
use VegGuide::Schema;

my %opts = ( days => 7 );
GetOptions(
'days:i' => \$opts{days},
);

my $dbh = VegGuide::Schema->Connect()->driver()->handle();

$dbh->do(
'DELETE FROM Session WHERE expires < ?', {},
DateTime->now( time_zone => 'UTC' )->subtract( days => $opts{days} )->epoch()
);
79 changes: 35 additions & 44 deletions bin/vg-log-monitor
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,24 +14,23 @@ use File::Tail;
use VegGuide::Config;
use VegGuide::JSON;


my $file = '/var/log/apache2-backend/error.log';

my $interval = 5 * 60;
my $sleep = 60;
my $sleep = 60;

my $hostname = VegGuide::Config->Hostname();
my $from = 'log-monitor@' . $hostname;
my $sender = Email::Send->new( { mailer => 'Sendmail' } );
my $hostname = VegGuide::Config->Hostname();
my $from = 'log-monitor@' . $hostname;
my $sender = Email::Send->new( { mailer => 'Sendmail' } );
my $last_sent = 0;
my @messages;

my $local_tz = DateTime::TimeZone->new( name => 'local' );

my $tail = _make_tail();

while ( defined ( my $line = $tail->read() ) )
{
while ( defined( my $line = $tail->read() ) ) {

# Process all the messages that are pending if there's something
# in the logs.
next if process_line($line);
Expand All @@ -40,42 +39,37 @@ while ( defined ( my $line = $tail->read() ) )
sleep $sleep;
}

sub process_line
{
sub process_line {
my $line = shift;

return if $line eq '';

my %message;

if ( $line =~ /^([^[].*)/ )
{
if ( $line =~ /^([^[].*)/ ) {
$message{date} = DateTime->now( time_zone => $local_tz );
$message{level} = 'warning';
$message{text} = $1;
}
elsif ( $line =~ /^\[([^]]+)\] \[(error|warning)] vegguide: (.+)$/ )
{
$message{date} = DateTime::Format::HTTP->parse_datetime( $1, $local_tz );
elsif ( $line =~ /^\[([^]]+)\] \[(error|warning)] vegguide: (.+)$/ ) {
$message{date}
= DateTime::Format::HTTP->parse_datetime( $1, $local_tz );
$message{level} = $2;

my $text = $3;

if ( $text =~ /^{.+}$/ )
{
if ( $text =~ /^{.+}$/ ) {
$text =~ s/(\\.)/eval qq{"$1"}/eg;

my $error = VegGuide::JSON->Decode($text);

$text = 'URI: ' . $error->{uri};
if ( $error->{user} )
{
$text = 'URI: ' . $error->{uri};
if ( $error->{user} ) {
$text .= "\n";
$text .= 'User: ' . $error->{user}
$text .= 'User: ' . $error->{user};
}

if ( $error->{referer} )
{
if ( $error->{referer} ) {
$text .= "\n";
$text .= "Referer: $error->{referer}";
}
Expand All @@ -97,8 +91,7 @@ sub process_line
return 1;
}

sub send_if_pending
{
sub send_if_pending {
return unless @messages;

my $now = time;
Expand All @@ -107,25 +100,24 @@ sub send_if_pending

my $body = '';

for my $msg (@messages)
{
for my $msg (@messages) {
$body .= "\n\n" if $body;

$body .= $msg->{date}->strftime( '%Y-%m-%d %H:%M:%S' ) . q{ - } . $msg->{level};
$body .= $msg->{date}->strftime('%Y-%m-%d %H:%M:%S') . q{ - }
. $msg->{level};
$body .= "\n";
$body .= $msg->{text};
}

my $email =
Email::Simple->create
( header =>
[ From => $from,
To => 'autarch@urth.org',
Subject => "VegGuide ($hostname) log errors",
'Message-ID' => Email::MessageID->new(),
],
body => $body,
);
my $email = Email::Simple->create(
header => [
From => $from,
To => 'autarch@urth.org',
Subject => "VegGuide ($hostname) log errors",
'Message-ID' => Email::MessageID->new(),
],
body => $body,
);

$sender->send($email);

Expand All @@ -134,11 +126,10 @@ sub send_if_pending
@messages = ();
}

sub _make_tail
{
return
File::Tail->new( name => $file,
resetafter => 3600 * 8,
nowait => 1,
);
sub _make_tail {
return File::Tail->new(
name => $file,
resetafter => 3600 * 8,
nowait => 1,
);
}
4 changes: 2 additions & 2 deletions inc/VegGuide/Build.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -290,7 +290,7 @@ sub _find_things {
my $rule = File::Find::Rule->new();

$rule = $rule->or(
$rule->new()->directory()->name('.hg')->prune()->discard(),
$rule->new()->directory()->name('.git')->prune()->discard(),

$rule->new()->name('*~')->prune()->discard(),

Expand Down Expand Up @@ -381,7 +381,7 @@ sub ACTION_write_revision_file {

require VegGuide::Config;

my ($revision) = `hg tip` =~ /changeset:\s+(\d+)/;
my ($revision) = `git log -n 1` =~ /commit\s+(......)/;

return unless $revision;

Expand Down
40 changes: 40 additions & 0 deletions lib/VegGuide.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,6 +44,46 @@ __PACKAGE__->response_class('VegGuide::Response');

__PACKAGE__->setup();

{

# monkey patch to fix Catalyst::Runtime issue
use Moose::Util qw/find_meta/;

sub setup_engine {
my ( $class, $requested_engine ) = @_;

my $engine = $class->engine_class($requested_engine);

# Don't really setup_engine -- see _setup_psgi_app for explanation.
return if $class->loading_psgi_file;

Class::MOP::load_class($engine);

if ( $ENV{MOD_PERL} ) {
my $apache = $class->engine_loader->auto;

my $meta = find_meta($class);
my $was_immutable = $meta->is_immutable;
my %immutable_options = $meta->immutable_options;
$meta->make_mutable if $was_immutable;

$meta->add_method(
handler => sub {
my $r = shift;
my $psgi_app = $class->_finalized_psgi_app;
$apache->call_app( $r, $psgi_app );
}
);

$meta->make_immutable(%immutable_options) if $was_immutable;
}

$class->engine( $engine->new );

return;
}
}

sub skin {
my $self = shift;

Expand Down
Loading

0 comments on commit a4db1f2

Please sign in to comment.