temporarily disabling torrus source build
[freeside.git] / FS / FS / Cron / backup.pm
1 package FS::Cron::backup;
2
3 use strict;
4 use vars qw( @ISA @EXPORT_OK );
5 use Exporter;
6 use File::Copy;
7 use Date::Format;
8 use FS::UID qw(driver_name datasrc);
9 use FS::Log
10
11 @ISA = qw( Exporter );
12 @EXPORT_OK = qw( backup );
13
14 sub backup {
15   my $conf = new FS::Conf;
16   my $localdest = $conf->config('dump-localdest');
17   my $scpdest = $conf->config('dump-scpdest');
18   return unless $localdest || $scpdest;
19
20   my $filename = time2str('%Y%m%d%H%M%S',time);
21
22   datasrc =~ /dbname=([\w\.]+)$/
23     or backup_log_and_die($filename,"unparsable datasrc ". datasrc);
24   my $database = $1;
25
26   my $ext;
27   if ( driver_name eq 'Pg' ) {
28     system("pg_dump -Fc $database >/var/tmp/$database.Pg");
29     $ext = 'Pg';
30   } elsif ( driver_name eq 'mysql' ) {
31     system("mysqldump $database >/var/tmp/$database.sql");
32     $ext = 'sql';
33   } else {
34     backup_log_and_die($filename,"database dumps not yet supported for ". driver_name);
35   }
36   chmod 0600, "/var/tmp/$database.$ext";
37
38   if ( $conf->config('dump-pgpid') ) {
39     eval 'use GnuPG;';
40     backup_log_and_die($filename,$@) if $@;
41     my $gpg = new GnuPG;
42     $gpg->encrypt( plaintext => "/var/tmp/$database.$ext",
43                    output    => "/var/tmp/$database.gpg",
44                    recipient => $conf->config('dump-pgpid'),
45                  );
46     unlink "/var/tmp/$database.$ext"
47       or backup_log_and_die($filename,$!);
48     chmod 0600, "/var/tmp/$database.gpg";
49     $ext = 'gpg';
50   }
51
52   if ( $localdest ) {
53     copy("/var/tmp/$database.$ext", "$localdest/$filename.$ext")
54       or backup_log_and_die($filename,$!);
55     chmod 0600, "$localdest/$filename.$ext";
56   }
57
58   if ( $scpdest ) {
59     eval "use Net::SCP qw(scp);";
60     backup_log_and_die($filename,$@) if $@;
61     my $scp = new Net::SCP;
62     $scp->scp("/var/tmp/$database.$ext", "$scpdest/$filename.$ext")
63       or backup_log_and_die($filename, $scp->{errstr});
64   }
65
66   unlink "/var/tmp/$database.$ext" or backup_log_and_die($filename,$!); #or just warn?
67
68   backup_log($filename);
69
70 }
71
72 #runs backup_log and dies with same error message
73 sub backup_log_and_die {
74   my ($filename,$error) = @_;
75   $error = "backup_log_and_die called without error message" unless $error;
76   backup_log($filename,$error);
77   die $error;
78 }
79
80 #logs result
81 sub backup_log {
82   my ($filename,$error) = @_;
83   my $result = $error ? "FAILED: $error" : 'succeeded';
84   my $message = "backup $filename $result\n";
85   my $log = FS::Log->new('Cron::backup');
86   if ($error) {
87     $log->error($message);
88   } else {
89     $log->info($message);
90   }
91   return;
92 }
93
94 1;