1 #! /usr/bin/perl |
|
2 # (c) 2015 Heiko Schlittermann <hs@schlittermann.de> |
|
3 use strict; |
|
4 use 5.10.0; |
|
5 use warnings; |
|
6 use Pod::Usage; |
|
7 use Getopt::Long; |
|
8 use File::Basename; |
|
9 use File::Spec::Functions; |
|
10 |
|
11 use Data::Dumper; |
|
12 |
|
13 my $opt_tasks; |
|
14 my $opt_dry; |
|
15 my $opt_keep = undef; |
|
16 my $opt_basedir = '.'; |
|
17 my $opt_min_age = txt2days('1d'); |
|
18 |
|
19 my $dir_template = '$version-$cluster-$date'; # do not change! |
|
20 |
|
21 delete @ENV{ grep /^LC_/ => keys %ENV }; |
|
22 |
|
23 exit main() if not caller; |
|
24 |
|
25 sub main { |
|
26 |
|
27 GetOptions( |
|
28 'k|keep=i' => \$opt_keep, |
|
29 'd|basedir=s' => \$opt_basedir, |
|
30 'dry' => \$opt_dry, |
|
31 'min-age=s' => sub { $opt_min_age = txt2days($_[1]) }, |
|
32 'h|help' => sub { pod2usage(-verbose => 1, -exit => 0) }, |
|
33 'm|man' => sub { |
|
34 pod2usage( |
|
35 -verbose => 2, |
|
36 -exit => 0, |
|
37 -noperldoc => system('perldoc -V >/dev/null 2>&1') |
|
38 ); |
|
39 }, |
|
40 ); |
|
41 |
|
42 my @clusters = ls_clusters(); |
|
43 |
|
44 # process the command line and get a list of tasks to do |
|
45 my @tasks = map { |
|
46 state $date = date(); |
|
47 my $version = $_->{version}; |
|
48 my $cluster = $_->{cluster}; |
|
49 my $dirname = eval "\"$dir_template\""; |
|
50 $_->{dirname} = catfile($opt_basedir, $dirname); |
|
51 $_; |
|
52 } sort do { |
|
53 if (@ARGV) { |
|
54 my $v = $ARGV[0]; |
|
55 if (@ARGV > 1) { |
|
56 my %h = |
|
57 map { $_->{cluster} => $_ } |
|
58 grep { $_->{version} eq $v } @clusters; |
|
59 @h{ @ARGV[1 .. $#ARGV] }; |
|
60 } |
|
61 else { |
|
62 grep { $_->{version} eq $v } @clusters; |
|
63 } |
|
64 } |
|
65 else { |
|
66 grep { $_->{status} eq 'online' } @clusters; |
|
67 } |
|
68 }; |
|
69 |
|
70 # now get the real jobe done |
|
71 # run for all tasks, regardless of errors |
|
72 |
|
73 foreach my $task (@tasks) { |
|
74 |
|
75 rmdir glob("$opt_basedir/*"); |
|
76 mkdir $task->{dirname} |
|
77 or die "$0: Can't mkdir $task->{dirname}: $!\n"; |
|
78 |
|
79 my @cmd = ( |
|
80 pg_basebackup => '--format' => 't', |
|
81 '--xlog', |
|
82 '--cluster' => $task->{name}, |
|
83 '--pgdata' => $task->{dirname}, |
|
84 '--gzip', |
|
85 -t 0 ? '--progress' : () |
|
86 ); |
|
87 |
|
88 if ($opt_dry) { |
|
89 print sprintf "%s %s\n", $task->{name}, "@cmd"; |
|
90 $task->{exit} = 0; |
|
91 next; |
|
92 } |
|
93 |
|
94 system @cmd; |
|
95 warn "$0: `@cmd` failed\n" if $?; |
|
96 $task->{exit} = $?; |
|
97 } |
|
98 |
|
99 # check the results |
|
100 |
|
101 foreach my $task (@tasks) { |
|
102 printf "%-10s %-20s %s\n", |
|
103 $task->{exit} ? "FAIL:$task->{exit}" : 'OK', |
|
104 $task->{cluster}, |
|
105 $task->{dirname}; |
|
106 } |
|
107 |
|
108 return 0 if not $opt_keep; |
|
109 |
|
110 # care about the backups to keep, if everything went fine so far |
|
111 rmdir glob "$opt_basedir/*"; # remove empty directories |
|
112 |
|
113 foreach my $task (grep { !$_->{exit} } @tasks) { |
|
114 |
|
115 # sorted list, from oldest to youngest backup |
|
116 my @old = grep { -M > $opt_min_age } glob catfile $opt_basedir, do { |
|
117 my $version = $task->{version}; |
|
118 my $cluster = $task->{cluster}; |
|
119 my $date = '*'; |
|
120 eval "\"$dir_template\""; |
|
121 }; |
|
122 |
|
123 if ($opt_keep <= @old) { |
|
124 splice @old, -1 * $opt_keep; |
|
125 foreach (@old) { |
|
126 if ($opt_dry) { |
|
127 print "would unlink $_\n"; |
|
128 next; |
|
129 } |
|
130 unlink glob "$_/*.tar.gz"; |
|
131 rmdir $_; |
|
132 } |
|
133 } |
|
134 |
|
135 } |
|
136 |
|
137 } |
|
138 |
|
139 sub date { |
|
140 my @now = localtime; |
|
141 sprintf '%4d-%02d-%02dT%02d-%02d-%02d', |
|
142 $now[5] + 1900, |
|
143 $now[4] + 1, |
|
144 $now[3], |
|
145 @now[reverse 0 .. 2]; |
|
146 } |
|
147 |
|
148 sub ls_clusters { |
|
149 my @clusters; |
|
150 |
|
151 foreach (map { [(split)[0 .. 3]] } `pg_lsclusters -h`) { |
|
152 push @clusters, |
|
153 { |
|
154 name => "$_->[0]/$_->[1]", |
|
155 version => $_->[0], |
|
156 cluster => $_->[1], |
|
157 port => $_->[2], |
|
158 status => $_->[3], |
|
159 }; |
|
160 } |
|
161 return @clusters; |
|
162 } |
|
163 |
|
164 sub txt2days { |
|
165 local $_ = shift; |
|
166 my $seconds; |
|
167 if (/(\d+)w/) { $seconds += $1 * 604800; } |
|
168 if (/(\d+)d/) { $seconds += $1 * 86400; } |
|
169 if (/(\d+)h/) { $seconds += $1 * 3600; } |
|
170 if (/(\d+)m/) { $seconds += $1 * 60; } |
|
171 if (/(\d+)s?$/) { $seconds += $1; } |
|
172 return $seconds / 86400; |
|
173 } |
|
174 |
|
175 exit main() if not caller; |
|
176 |
|
177 __END__ |
|
178 |
|
179 =head1 NAME |
|
180 |
|
181 pg-backup - backup all active PostgreSQL clusters |
|
182 |
|
183 =head1 SYNOPSIS |
|
184 |
|
185 pg-backup [options] [<version> [<cluster>]...] |
|
186 |
|
187 =head1 DESCRIPTION |
|
188 |
|
189 for all active PostgreSQL clusters and writes the backups as TAR archives. |
|
190 |
|
191 If a I<version> and optionally I<cluster>s are specified on the command line, |
|
192 all clusters (or the specified clusters) of the I<version> are saved. |
|
193 |
|
194 Without any I<version>/I<cluster> specification all B<online> clusters are backed up. |
|
195 |
|
196 =head1 OPTIONS |
|
197 |
|
198 =over |
|
199 |
|
200 =item B<-d>|B<--basedir> I<dir> |
|
201 |
|
202 The directory where the subdirectories for the backups will be placed. (default: F<.>) |
|
203 |
|
204 =item B<-k>|B<--keep> I<n> |
|
205 |
|
206 The number of generations to keep. Old backups will be only removed if B<all> |
|
207 specified backups succeed. (no default) |
|
208 |
|
209 =item B<--dry> |
|
210 |
|
211 Dry run, show what will be done. (default: undef) |
|
212 |
|
213 =item B<--min-age> I<time> |
|
214 |
|
215 The minimum age of old backups before the B<--keep> option tries to cleanup. |
|
216 The timestamp of the directory with the tar archive is relevant. Nothing else! |
|
217 (default: 1d) |
|
218 |
|
219 =back |
|
220 |
|
221 =head1 AUTHOR |
|
222 |
|
223 Heiko Schlittermann L<mailto:hs@schlittermann.de> |
|
224 |
|
225 =cut |
|