File: cleanup.pl

package info (click to toggle)
remstats 1.00a4-8woody1
  • links: PTS
  • area: main
  • in suites: woody
  • size: 4,576 kB
  • ctags: 1,020
  • sloc: perl: 11,706; ansic: 2,776; makefile: 944; sh: 869
file content (112 lines) | stat: -rwxr-xr-x 3,053 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
#!@@PERL@@ @@PERLOPTS@@

# Copyright 1999, 2000, 2001 (c) Thomas Erskine <@@AUTHOR@@>
# See the COPYRIGHT file with the distribution.

# cleanup - remove cruft that gets left around.  Run it out of cron
# $Id: cleanup.pl,v 1.4 2001/08/28 15:22:24 remstats Exp $

# - - -   Configuration   - - -

use strict;

# What is this program called, for error-messages and file-names
$main::prog = 'cleanup';
# Where is the default configuration dir
$main::config_dir = '@@CONFIGDIR@@';

# - - -   Version History   - - -

(undef, $main::version) = split(' ', '$Revision: 1.4 $');

# - - -   Setup   - - -

use lib '.', '@@LIBDIR@@', '@@RRDLIBDIR@@';
require "remstats.pl";
use Getopt::Std;

# Parse the command-line
my %opt = ();
getopts('d:f:h', \%opt);

if (defined $opt{'h'}) { &usage; } # no return
if (defined $opt{'d'}) { $main::debug = $opt{'d'}; } else { $main::debug = 0; }
if (defined $opt{'f'}) { $main::config_dir = $opt{'f'}; }

&read_config_dir($main::config_dir, 'general', 'html', 'groups', 'oids', 
	'rrds', 'groups', 'host-templates', 'hosts');

# No buffering when debugging
if ($main::debug) { $| = 1; }

# - - -   Mainline   - - -

my ($host);

# Some directories shouldn't have old files in them
&clean_dir( $main::config{DATADIR}. '/LAST', 24*60*60, '*');
&clean_dir( $main::config{DATADIR}. '/LOGS', $main::config{KEEPLOGS}, '*');
&clean_dir( $main::config{DATADIR}. '/TRACEROUTES', $main::config{KEEPLOGS}, '*');
&clean_dir( $main::config{HTMLDIR}. '/MOVIES', 24*60*60, 'snap-*.png', 'snap-*.gif');

# Clean host graphs
foreach $host (keys %{$main::config{HOST}}) {
	next if ($host eq '_remstats_');
	&clean_dir( $main::config{HTMLDIR} .'/'.  $main::config{HTML}{KEEPIMAGES}, 
		'snap-*.png', 'snap-*.gif');
}

exit 0;

#----------------------------------------------------------------- clean_dir ---
sub clean_dir {
	my ($dir, $max_age, @patterns) = @_;
	my (@files, $file, $age, $pattern);

# Collect the list of files
	@files = ();
	foreach my $pattern (@patterns) {
		push @files, glob $dir . '/' . $pattern;
	}

# Check each one
	foreach $file (@files) {
		next if( $file =~ /^\./);
		$age = (-M $file) * 24*60*60;
		if ($age > $max_age) {
			unlink $file or &error("can't unlink $file: $!");
		}
	}
}

#----------------------------------------------------------------- usage ---
sub usage {
	print STDERR <<"EOD_USAGE";
$main::prog version $main::version
usage: $0 [options]
where options are:
    -d nnn  enable debugging output at level 'nnn'
    -f fff  use 'fff' for config-dir [$main::config_dir]
    -h      show this help
EOD_USAGE
	exit 0;
}

#----------------------------------------------------------------- debug ---
sub debug {
	my $msg = join('', @_);
	print STDERR "DEBUG: $msg\n";
}

#------------------------------------------------------------------ abort ---
sub abort {
	my $msg = join('', @_);
	print STDERR "$main::prog: ABORT: $msg\n";
	exit 1;
}

#------------------------------------------------------------------ error ---
sub error {
	my $msg = join('', @_);
	print STDERR "$main::prog: ERROR: $msg\n";
}