74 lines
		
	
	
		
			2.5 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
		
		
			
		
	
	
			74 lines
		
	
	
		
			2.5 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
|  | #!/usr/bin/perl -w | ||
|  | 
 | ||
|  | #---------------------------------------------------------------------- | ||
|  | # copyright (C) 1999-2005 Mitel Networks Corporation | ||
|  | #  | ||
|  | # This program is free software; you can redistribute it and/or modify | ||
|  | # it under the terms of the GNU General Public License as published by | ||
|  | # the Free Software Foundation; either version 2 of the License, or | ||
|  | # (at your option) any later version. | ||
|  | # 		 | ||
|  | # This program is distributed in the hope that it will be useful, | ||
|  | # but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
|  | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the | ||
|  | # GNU General Public License for more details. | ||
|  | # 		 | ||
|  | # You should have received a copy of the GNU General Public License | ||
|  | # along with this program; if not, write to the Free Software | ||
|  | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA | ||
|  | #  | ||
|  | # Technical support for this program is available from Mitel Networks  | ||
|  | # Please visit our web site www.mitel.com/sme/ for details. | ||
|  | #---------------------------------------------------------------------- | ||
|  | 
 | ||
|  | use strict; | ||
|  | use Errno; | ||
|  | use File::Find; | ||
|  | use esmith::ConfigDB; | ||
|  | 
 | ||
|  | my $cdb = esmith::ConfigDB->open_ro; | ||
|  | 
 | ||
|  | my $rsyslog = $cdb->get('rsyslog') or die "No rsyslog db entry found"; | ||
|  | my $length = $rsyslog->prop('PurgeLength') || '95'; | ||
|  | 
 | ||
|  | $ENV{'PATH'} = "/bin"; | ||
|  | 
 | ||
|  | #---------------------------------------------------------------------- | ||
|  | # Find all files in /var/log/ that are: | ||
|  | #    - real files | ||
|  | #    - older than rsyslog{PurgeLength}, or 95 days if unset | ||
|  | #    - matches our log naming scheme | ||
|  | # and eliminate them. | ||
|  | #---------------------------------------------------------------------- | ||
|  | 
 | ||
|  | 
 | ||
|  | chdir "/var/log/" | ||
|  |     or die "Could not chdir to /var/log"; | ||
|  | 
 | ||
|  | sub process | ||
|  | { | ||
|  |     #------------------------------------------------------------------ | ||
|  |     # Files older than $length days, matching our naming scheme. | ||
|  |     #------------------------------------------------------------------ | ||
|  |     if ( -f and (int(-M) > $length) and /^[A-Za-z_].*\.\d{14}$/ ) | ||
|  |     { | ||
|  | 	unlink("$_") | ||
|  | 	    or die "Could not purge log $File::Find::name: $!\n"; | ||
|  |     } | ||
|  | 
 | ||
|  |     #------------------------------------------------------------------ | ||
|  |     # Files which are symlinks matching the naming scheme. | ||
|  |     # They may have been left behind from older versions of the | ||
|  |     # logrotate event. | ||
|  |     #------------------------------------------------------------------ | ||
|  |     if ( -l and /^[A-Za-z_].*\.\d{14}$/ ) | ||
|  |     { | ||
|  | 	unlink("$_") | ||
|  | 	    or die "Could not purge log $File::Find::name: $!\n"; | ||
|  |     } | ||
|  | } | ||
|  | 
 | ||
|  | find(\&process, glob('.')); | ||
|  | 
 | ||
|  | exit 0; |