#!/p4/common/perl/bin/perl -w #============================================================================== # Copyright and license info is available in the LICENSE file included with # the Server Deployment Package (SDP), and also available online: # https://swarm.workshop.perforce.com/projects/perforce-software-sdp/view/main/LICENSE #------------------------------------------------------------------------------ # For a summary of command line options, run: p4pcm.pl -h # This runs on Unix/Linux systems only. # Log file is p4pcm.log, in $LOGS dir. use strict; use File::Find; use File::Basename; use Getopt::Long; use POSIX; #------------------------------------------------------------------------------ # Initialization #------------------------------------------------------------------------------ BEGIN { $main::ThisScript = basename($0); $main::Version = "1.1.4"; } #------------------------------------------------------------------------------ # Prototypes for local functions. #------------------------------------------------------------------------------ sub usage(); sub getDriveSpace($;); #------------------------------------------------------------------------------ # Declarations #------------------------------------------------------------------------------ # If $Freespace is less than $ThresholdLow, then start deleting files. # $ThresholdHigh is the amount of diskspace we want available/free constantly. # They are specified in kilobyte units. my $AcctTime; my $TopDir; my $ThresholdLow = 10737418240; # 10GB my $ThresholdHigh = 21474836480; # 20GB my $TotalSize; my $Freespace; my $Timestamp; my $Datestamp; my @RmList; my $RmFile; my @DateSorted; my %Oldest; #------------------------------------------------------------------------------ # Function: usage() # Displays usage message. #------------------------------------------------------------------------------ sub usage () { print "\nUsage:\n $main::ThisScript [-d \"proxy cache dir\"] [-tlow <low_threshold>] [-thigh <high_threshold>] [-n] or $main::ThisScript -h This utility removes files in the proxy cache if the amount of free disk space falls below the low threshold (default 10GB). It removes files (oldest first) until the high threshold is (default 20GB) is reached. Specify the thresholds in kilobyte units (kb). The '-d \"proxy cache dir\"' argument is required unless \$P4PCACHE is defined, in which case it is used. The log is \$LOGS/p4pcm.log if \$LOGS is defined, else p4pcm.log in the current directory. Use '-n' to show what files would be removed. "; exit 1;; } #------------------------------------------------------------------------------ # Function getDriveSpace($TopDir) # Returns a 2-element array containing $totalspace and $Freespace, i.e. # returns ($totalspace, $Freespace). #------------------------------------------------------------------------------ sub getDriveSpace($;) { my ($TopDir) = @_; my $totalSpace; my $freeSpace; my $dirInfo; my $junk; # Run 'df -k $TopDir', and extract the total and available space values, # using $junk to ignore extranneous information. $dirInfo = `df -k $TopDir`; $dirInfo =~ s/^.*?\n//; # Zap the header line. $dirInfo =~ s/\s+/,/gs; # Replace whitespace with comma as field delimiter. ($junk, $totalSpace, $junk, $freeSpace, $junk, $junk) = split (',',$dirInfo); return ($totalSpace, $freeSpace); } #------------------------------------------------------------------------------ # Parse command line. #------------------------------------------------------------------------------ Getopt::Long::config "no_ignore_case"; Getopt::Long::config "auto_abbrev"; GetOptions(\%main::CmdLine, "help", "noop", "dir=s", "tlow=s", "thigh=s") or die "\nUsage Error: Unrecognized argument.\n"; # Validate command line arguments. usage() if $main::CmdLine{'help'}; # The '-d <TopDir>' argument is required unless P4PCACHE is defined in the # shell environment. if ($main::CmdLine{'dir'}) { $TopDir = $main::CmdLine{'dir'}; } elsif ($ENV{P4PCACHE}) { $TopDir = $ENV{P4PCACHE}; } else { usage (); } $ThresholdLow = $main::CmdLine{'tlow'} if ($main::CmdLine{'tlow'}); $ThresholdHigh = $main::CmdLine{'thigh'} if ($main::CmdLine{'thigh'}); #------------------------------------------------------------------------------ # Main Program. #------------------------------------------------------------------------------ $Datestamp = strftime("\%Y-\%m-\%d",localtime); $Timestamp = strftime("\%H:\%M:\%S",localtime); my ($name, $dir, $ext) = fileparse($0, '\..*'); my $logfile; if ($ENV{LOGS}) { $logfile = "$ENV{LOGS}/$name.log"; } else { $logfile = "$name.log"; } open (LOG, ">>$logfile"); print LOG "==============================================================================\n"; print LOG "Started $main::ThisScript v$main::Version at $Datestamp $Timestamp\n"; # Check if $TopDir exists and that it's a directory. if (-e $TopDir && -d $TopDir) { # Find the total amount of free space in $TopDir. ($TotalSize, $Freespace) = getDriveSpace($TopDir); print LOG "Free Space = $Freespace, Low space threshold = $ThresholdLow.\n"; # compare $Freespace to $ThresholdLow if ( $Freespace < $ThresholdLow ) { # while $Freespace is less than $ThresholdHigh # Find oldest file based on "Date Modified" find (sub {$Oldest{$File::Find::name} = -M if -f;}, $TopDir); @DateSorted = sort {(stat($a))[9] <=> (stat($b))[9] } keys %Oldest; while ( $Freespace < $ThresholdHigh ) { $RmFile = shift @DateSorted; last unless ($RmFile); # The stat() function returns size in bytes. Divide by 1024 # to get size in Kilobytes. $Freespace += (stat($RmFile))[7]/1024; push(@RmList, $RmFile); } # if @RmList exists, delete it + log if ( @RmList ) { # record the files that will be deleted print LOG "File \t Size \t Accessed\n"; foreach $RmFile ( @RmList ) { $AcctTime = (stat($RmFile))[9]; print LOG "$RmFile \t " . (stat($RmFile))[7] . "\t" . scalar(localtime($AcctTime)) . "\n"; } # Delete files to free space. if ($main::CmdLine{'noop'}) { print LOG "NO-OP: The following files would have been deleted:\n"; foreach $RmFile (@RmList) { print LOG "$RmFile\n"; } } else { print LOG "Files deleted:\n"; foreach $RmFile (@RmList) { unlink $RmFile or print LOG "ERROR: File not deleted:\n$RmFile\n"; } } } } else { # log: There is enough free space in $TopDir until next time print LOG "No files need to be deleted.\n"; } } else { print LOG "\nError: The cache directory [$TopDir] does not exist or is not a directory. Aborting.\n"; } # Stop logging. $Datestamp = strftime("\%Y-\%m-\%d",localtime); $Timestamp = strftime("\%H:\%M:\%S",localtime); print LOG "\nCompleted at $Datestamp $Timestamp.\n"; close(LOG);
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#16 | 30621 | Neal Firth |
Enhanced messaging to allow easier determination of operation in progress using a tail of the log file. Moved delete of the nomination file from before space recovery deletes until after space recovery deletes. Otherwise, a run overlapping the space recovery deletes could potentially include files nominated for delete resulting in a smaller than expected recovery of space. |
||
#15 | 30522 | Robert Cowham | Conver DOS line endings to Unix | ||
#14 | 30519 | Neal Firth |
Modified through swarm to change DOS line endings to Unix line endings. #review-30520 |
||
#13 | 30426 | Neal Firth |
Modified through swarm. #review Major changes. Effectively a new approach. Significant performance improvements. Specifically: * Change from time-last-modified to time-last-accessed. * Replace perl based find code with effectively equivalent shell code. Operates at least 7 times faster with smaller resource footprint than the perl code. * Threshold parameters can be specified as percentage of total disk space. * Enhanced parameter validation. * Enhanced log information for better performance tracking and debug support. * Added check so that a new run does not interrupt a run in progress. * Updated help information to reflect new technologies and capabilities. * Added internal algorithm related comments to aid future support/ enhancements. * Minor code consistency changes. Mostly adding support functions to standardize. |
||
#12 | 29585 | C. Thomas Tyler | Rollback of accidental submit of wrong file. | ||
#11 | 29584 | C. Thomas Tyler | Added '-v' (verbose) option and some debugging output. | ||
#10 | 29301 | C. Thomas Tyler |
p4pcm.pl v1.1.7: Adjusted shebang line. The prior shebang line forced usage of /p4/common/perl/bin/perl. At one point in history that was more reliably available, when building a self-contained Perl in the SDP was more common. But no longer. The shebang line now finds perl from PATH. The default SDP path still prefers /p4/common/perl/bin, so if a perl exists there it will be used. This change will have no functional impact to existing installations that have and user /p4/common/perl, but will not require new installstions to build a self-contained perl. #review-29302 |
||
#9 | 28215 | C. Thomas Tyler | Merge Down from main -> dev. | ||
#8 | 27722 | C. Thomas Tyler |
Refinements to @27712: * Resolved one out-of-date file (verify_sdp.sh). * Added missing adoc file for which HTML file had a change (WorkflowEnforcementTriggers.adoc). * Updated revdate/revnumber in *.adoc files. * Additional content updates in Server/Unix/p4/common/etc/cron.d/ReadMe.md. * Bumped version numbers on scripts with Version= def'n. * Generated HTML, PDF, and doc/gen files: - Most HTML and all PDF are generated using Makefiles that call an AsciiDoc utility. - HTML for Perl scripts is generated with pod2html. - doc/gen/*.man.txt files are generated with .../tools/gen_script_man_pages.sh. #review-27712 |
||
#7 | 26649 | Robert Cowham |
More SDP Doc tidy up. Removed some command summary files. |
||
#6 | 25552 | C. Thomas Tyler |
Fixed off-by-three-orders-of-magnitude error in Proxy cleanup script. The key change is to adjust the output of a stat() call, dividing the numeric value in bytes returned by 1024 to get the number of Kilobytes. This script makes use of the Perl stat() function, the details of which are helpful: https://perldoc.perl.org/functions/stat.html See also: SDP-191 and change @21751. This was an earlier change that detected the bytes/Kilobtyes confusion, and addressed it by adjusting the default threshhold values from the baseline version. This change change undoes that method of addressing the problem, rolling back to the original defaults for thresholds. Now with the calculation adjusted to use KB rather than bytes, the original change is no longer needed. #review @amorriss |
||
#5 | 21751 | C. Thomas Tyler | Merged Erik's change to dev. | ||
#4 | 19250 | C. Thomas Tyler |
SDP-ified: * Now puts the p4pcm.log file in $LOGS dir. * No longer requires '-d' flag if $P4PCACHE environment variable is defined. Also did some internal refactoring. To Do: The log just grows and is not rotated. |
||
#3 | 16029 | C. Thomas Tyler |
Routine merge to dev from main using: p4 merge -b perforce_software-sdp-dev |
||
#2 | 12169 | Russell C. Jackson (Rusty) |
Updated copyright date to 2015 Updated shell scripts to require an instance parameter to eliminate the need for calling p4master_run. Python and Perl still need it since you have to set the environment for them to run in. Incorporated comments from reviewers. Left the . instead of source as that seems more common in the field and has the same functionality. |
||
#1 | 10638 | C. Thomas Tyler | Populate perforce_software-sdp-dev. | ||
//guest/perforce_software/sdp/main/Server/Unix/p4/common/bin/p4pcm.pl | |||||
#1 | 10148 | C. Thomas Tyler | Promoted the Perforce Server Deployment Package to The Workshop. |