|
|
| (16 intermediate revisions by the same user not shown) |
| Line 1: |
Line 1: |
| − | {{Wrongtitle|autobackup.pl}}
| |
| − | {{Script info
| |
| − | |author=Phil Brady
| |
| − | |short=Selective backup of recordings to a small partition.
| |
| − | |long=Maintains a subset of recordings, taking into account age and whether they are part of a series.
| |
| − | |category=Maintenance
| |
| − | |file=autobackup.pl
| |
| − | |S25=yes}}
| |
| | | | |
| − | '''DESCRIPTION:'''
| |
| − |
| |
| − | autobackup.pl selects a useful subset of mythtv recordings and makes a backup of them to a destination partition which is typically smaller than the total size of all recordings and which is on a separate disk. It allows recovery of service with a 'useful' set of recordings in case of primary disk failure. It should be augmented by appropriate database and system backups.
| |
| − |
| |
| − |
| |
| − | '''OPTIONS:'''
| |
| − |
| |
| − | :--preview or -p
| |
| − | ::to inhibit file copy/deletes. This shows what action would be taken with a full run but without changing the filestore.
| |
| − |
| |
| − | :--loglevel n to set logging levels.
| |
| − | ::n=0 for only errors
| |
| − | ::n=1 for calling info,
| |
| − | ::n=2 for stats,
| |
| − | ::n=3 for a recordings list
| |
| − | ::n=4 for protocol diagnostics
| |
| − | :::Default is 3.
| |
| − |
| |
| − | :--help or -h Help text
| |
| − | :--delete <filename>
| |
| − | ::deletes file from destination directory. For use with the recording delete system event, though use is optional.
| |
| − |
| |
| − |
| |
| − | '''DETAILS:'''
| |
| − |
| |
| − | autobackup.pl is intended to be run as a regular job at system closedown when the system is otherwise idle. It checks:
| |
| − | *the destination partition to determine how full it is,
| |
| − | *the database to extract information about recordings
| |
| − | *the source directories as a consistency check
| |
| − | *The destination directory to identify recordings which have alreay been backed up and others which are obsolete and need removing.
| |
| − |
| |
| − | It is then in a state to identify series recordings, allocate priorities and determine the action for each file.
| |
| − | Files are selected for backup in date/time order (newest first) but:
| |
| − |
| |
| − | *recordings marked as non-expirable have a 20 year priority boost
| |
| − | *recordings which are recognised as episodes of a series can be bunched together with the latest episode and/or have a number of days added as a boost. The author finds bunching with zero days boost to be satisfactory.
| |
| − |
| |
| − | Three or more recordings with the same name and an average interval between them of less than 8 days are deemed to be a series.
| |
| − |
| |
| − | Files will be promoted from the head of the list, and files demoted as necessary from the end in order to prevent over-filling the partition.
| |
| − |
| |
| − | The script should handle recording groups with more than one source directory. The author has made limited tests of this scenario but only uses a single directory.
| |
| − |
| |
| − |
| |
| − | '''PARTITION LIMITS'''
| |
| − |
| |
| − | New recordings will be promoted whilst observing the partition limit of 90%. Older recordings will only be considered if the partition is below a partition threshold of 85% full. This is only likely happen after a spate of manual deletions.
| |
| − |
| |
| − | The two limits prevent a recording from falling in and out of favour as higher priority recordings are created and removed. Threshold should be a few days worth of recordings below limit for stability.
| |
| − |
| |
| − |
| |
| − | '''DELETED RECORDINGS'''
| |
| − |
| |
| − | Recordings can optionally be deleted from the destination directory with the RecordingDelete system event mechanism by calling this program with --delete %FILE%. This will remove the file more quickly.
| |
| − |
| |
| − | However, such files will be routinely deleted by this script even if the event system is not used. Recordings deleted routinely by the script have the advantage of appearing in the log file so giving a fuller picture of the change sin the state of files.
| |
| − |
| |
| − | Recordings which have been deleted from the database but still remain on the destination partition no longer have their name in the database. In order to give these a name in listings, the script writes a list of today's recordings to the file to enable the names to be established next day. The file is /var/lib/db_backups/autobackup.list. This directory is used to hold backups and control files from the sister database backup routine autobackup.sh.
| |
| − |
| |
| − |
| |
| − | '''WORKING PARAMETERS'''
| |
| − |
| |
| − | See the parameters (%params) at the head of the program defining parameters such as the destination partition, maximum percentage used, source directories, destination directories, default logging level, series action, threshold setting and name of recordings list file.
| |
| − |
| |
| − | On the author's system, the script is placed in /usr/bin/autobackup.pl. Logging is directed by autobackup.sh to /var/log/mythtv/autobackup.log
| |
| − | The source directory is /var/lib/mythtv/recordings and the destination /var/lib/mythtv2/recordings
| |
| − | The destination partition is /var/lib/mythtv2; the limit is 90% and the threshold 85%.
| |
| − |
| |
| − |
| |
| − | '''LOGGING'''
| |
| − |
| |
| − | If log files are required then they need to be redirected from STDOUT and STDERR and rotated as necessary by a calling script.
| |
| − |
| |
| − |
| |
| − | '''DATABASE BACKUPS'''
| |
| − |
| |
| − | The perl script has a sister routine autobackup.sh which takes a database backups. If this script is found then it will trigger it at last closedown of the day. See autobackup.sh.
| |
| − |
| |
| − |
| |
| − | '''PERFORMANCE'''
| |
| − |
| |
| − | This script takes negligible time to run, though file copying is a more lengthy operation. With SATA2 interfaces 6Gb/min is a rule of thumb. If the script is run daily, it will typically run in under a minute.
| |
| − |
| |
| − |
| |
| − | '''DEVELOPMENT REGIME'''
| |
| − |
| |
| − | The script has been developed and tested in the UK on a 64 bit Mythbuntu 12.04 (Mythtv 0.25) dedicated frontend/backend system with ACPI wakeup, DVB-T receivers, a single directory for recordings, and a local time close to or equal to GMT.
| |
| − |
| |
| − | A 500Gb disk holds root, swap and backup recording partitions; a 2Tb drive holds emergency root and swap and the primary
| |
| − | recording partition /var/lib/mythtv.
| |
| − |
| |
| − | This system has been developed with version 72 of mythtv protocol and it will need validating carefully against other implementations. To do so, you will need to add a new version and its key in %MythProtocolVersion and test thoroughly with --loglevel 4 and then with --preview.
| |
| − |
| |
| − |
| |
| − | '''Typical output'''
| |
| − | <pre>
| |
| − |
| |
| − |
| |
| − | </pre>
| |
| − |
| |
| − | {{perl|autobackup.pl|
| |
| − | <pre>
| |
| − | #!/usr/bin/perl -w
| |
| − | use strict;
| |
| − | use IO::Socket;
| |
| − | use Time::Local;
| |
| − |
| |
| − | #
| |
| − | # Select recordings for backup to a small partition and copy/delete as necessary.
| |
| − | # See --help for details
| |
| − | #
| |
| − | # Written by Phil Brady November 2012.
| |
| − | #
| |
| − |
| |
| − | #program version
| |
| − | use constant VERSION => '1.0 26 Nov 2012';
| |
| − |
| |
| − | #control parameters
| |
| − | my %params =(
| |
| − | "partition" => "/var/lib/mythtv2",
| |
| − | "destdir" => "/var/lib/mythtv2/recordings",
| |
| − |
| |
| − | "sourcedir1" => "/var/lib/mythtv/recordings", #first or only dir in recording group
| |
| − | # "sourcedir2" => "/var/lib/mythtv/other", #add others like this. Note sourcedir1 to n, not 0 to n
| |
| − |
| |
| − | "percent" => 90, # max used% of partition
| |
| − | "threshold" => 85, # percentage for older files to be promoted.
| |
| − | "SeriesPolicy"=> 1, # if set, use priority of newest member of a series. ] Use either, neither
| |
| − | "SeriesBoost" => 0, # boost in days for series. ] or both of these boosts.
| |
| − | "preview" => 0, # command line parameter -p or --preview.
| |
| − | "filelist" => "/var/lib/mythtv/db_backups/autobackup.list", #list recordings here so we can identify deleted ones next day
| |
| − | );
| |
| − |
| |
| − |
| |
| − | # default --loglevel parameter
| |
| − | my $loglevel=3; # 0=errors only, 1=calling params, 2=stats, 3=recordings details, 4=protocol diagnostic trace.
| |
| − |
| |
| − |
| |
| − | # backend parameters
| |
| − | use constant myipaddress => '127.0.0.1';
| |
| − | use constant backendip => '127.0.0.1';
| |
| − | my $sock;
| |
| − | my %MythProtocolVersion = (
| |
| − | '72' => 'D78EFD6F',
| |
| − | ); #add other versions here but do sanity check with loglevel 4 before use.
| |
| − |
| |
| − |
| |
| − | #constants for extracting details from program record
| |
| − | use constant recstart => 1; #start of first record
| |
| − | use constant reclength => 44; #length of each record
| |
| − | use constant recname => 0; #name of program
| |
| − | use constant recfilename => 10;
| |
| − | use constant recsize => 11; #recording size
| |
| − | use constant recflags => 27; #flags
| |
| − | use constant flagautoexp => 4;
| |
| − | use constant flagdeletepending => 128; #this bit utilised but never seen set!
| |
| − | use constant flagpriority => 1024; #not used.
| |
| − | use constant recgroup => 28; #more accurate indicator of pending delete
| |
| − |
| |
| − | my $gig= 1024*1024*1024;
| |
| − |
| |
| − | #info on recorded programs. Hashes all use filename as key.
| |
| − | my %frecname; #program name
| |
| − | my %fsize; #file size
| |
| − | my %fstatus; #recording status: 0=obsolete/deletepending,1=normal,2=series record, 3=vip recording
| |
| − | # +4 =secure before, +8=secure after.
| |
| − | my %fpriority; #hold merit for saving the recording
| |
| − | my %newest; #time of most recent episode in series
| |
| − | my @deleteq; #list of files for deletion
| |
| − | my @promoteq; #ditto promotion
| |
| − |
| |
| − | #statistics
| |
| − | my %stats;
| |
| − |
| |
| − | #---------ok, let's start!---------
| |
| − |
| |
| − | &parse_command_line;
| |
| − |
| |
| − | &check_partition;
| |
| − |
| |
| − | &scan_database; #to get list of recordings
| |
| − |
| |
| − | &mark_series; #identify series recordings and mark episodes
| |
| − |
| |
| − | #scan source directories and check consistency with database
| |
| − | &scansources;
| |
| − |
| |
| − | #scan destination directory. Identify which recordings are backed up and find obsolete ones.
| |
| − | &scandir($params{'destdir'},1);
| |
| − |
| |
| − | &maintain_list('read'); #obsolete recordings are anonymous. Get names by checking yesterday's list
| |
| − |
| |
| − | &decide_priorities; #based on expirability, obsolescence, series episode and recording time.
| |
| − |
| |
| − | #now sort them.
| |
| − | my @sorted = sort {$fpriority{$b} <=> $fpriority{$a} or #priority
| |
| − | $frecname{$b} cmp $frecname{$a} or #keeps series episodes together
| |
| − | substr($b,5,14) <=> substr($a,5,14)} keys %fstatus; #in date order
| |
| − | my @sorted2=@sorted;
| |
| − |
| |
| − | &decide_action; #decide promotions/demotions
| |
| − | #note: operation depends heavily on allocated priorities & sort order.
| |
| − |
| |
| − | &do_action; #now do the copies/deletes
| |
| − |
| |
| − | &showall if $loglevel==3; #list all known recordings
| |
| − |
| |
| − | &maintain_list('write'); #make new list so we can identify deleted recordings tomorrow
| |
| − |
| |
| − | #almost done!
| |
| − | printf "\nFinished: time taken %4d seconds\n",time-$^T if $loglevel;
| |
| − | exit 0;
| |
| − |
| |
| − | #-------------------
| |
| − | sub maintain_list{
| |
| − |
| |
| − | # Called with read or write.
| |
| − |
| |
| − | # This routine writes a list of saved recording file names and program names to a file.
| |
| − | # It checks the list the following day to put a name to deleted recordings which
| |
| − | # would otherwise be anonymous (named '??').
| |
| − |
| |
| − | # If you are using the recordingdelete event to remove backup recordings then you will probably
| |
| − | # not see these anonymous recordings.
| |
| − |
| |
| − | # To remove this functionality, uncomment the next line
| |
| − | # return;
| |
| − |
| |
| − | # Documentation/reminder: Myth delete mechanism seems to be:
| |
| − | # 1. changes group to 'Deleted'
| |
| − | # 2. Some while later, backend deletes file and removes entry from database.
| |
| − | # 3. Deletepending flag not seen in use.
| |
| − |
| |
| − | if ($_[0] eq 'read'){
| |
| − |
| |
| − | #check yesterday's list to name deleted recordings
| |
| − | my $nameyesterday;
| |
| − | if ($loglevel != 3){return}; #nobody listening!
| |
| − | if ($stats{'noname'}==0){return}; #no anonymous ones to check
| |
| − | unless (open FH, "<$params{'filelist'}"){
| |
| − | print "Warning: cannot read $params{'filelist'} $!\n";
| |
| − | return; #not fatal
| |
| − | }
| |
| − | while (<FH>){
| |
| − | chomp;
| |
| − | ($_,$nameyesterday)=split /\[\]:\[\]/,$_;
| |
| − | if (exists $frecname{$_}){
| |
| − | if ($frecname{$_} eq '??'){$frecname{$_} = ".$nameyesterday"};
| |
| − | }
| |
| − | }
| |
| − | close FH;
| |
| − |
| |
| − | }elsif ($_[0] eq 'write'){
| |
| − | if ($params{'preview'}) {return};
| |
| − |
| |
| − | #write list of backed up recordings for use tomorrow
| |
| − | unless (open FH, ">$params{'filelist'}"){
| |
| − | print "Cannot write $params{'filelist'} $!" if $loglevel >1;
| |
| − | return;
| |
| − | }
| |
| − | for (keys %fstatus){
| |
| − | if (($fstatus{$_} & 11) > 8){
| |
| − | #this is a backed up file so remember for tomorrow
| |
| − | print FH $_ . '[]:[]' . $frecname{$_}."\n";
| |
| − | }
| |
| − | }
| |
| − | close FH;
| |
| − | }else{
| |
| − | print "bad maintain_list $_[0]\n";
| |
| − | exit 1;
| |
| − | }
| |
| − | }
| |
| − | #-------------------
| |
| − | sub decide_priorities{
| |
| − | my $st;
| |
| − | foreach (keys %fstatus){
| |
| − | $st=($fstatus{$_} & 3);
| |
| − | if ($st==0){
| |
| − | $fpriority{$_}=0;
| |
| − | }elsif ($st==3){
| |
| − | $fpriority{$_} +=7305; #20 years boost for vip=non expirable
| |
| − | }elsif ($st==2){ #boost episodes of series
| |
| − | if ($params{'SeriesPolicy'}){
| |
| − | $fpriority{$_}=$newest{$frecname{$_}};
| |
| − | }
| |
| − | $fpriority{$_} += $params{'SeriesBoost'};
| |
| − | }
| |
| − | }
| |
| − | }
| |
| − | #-------------------
| |
| − | sub timestamp{
| |
| − | #extract timestamp from filename - return epoch DAYS as a real.
| |
| − |
| |
| − | (my $in)=@_; #filename
| |
| − | $in=substr($in,5,14);
| |
| − | my @bits=($in =~ m/../g);
| |
| − | my $out = timelocal($bits[6],$bits[5],$bits[4],$bits[3],$bits[2]-1,$bits[0].$bits[1]);
| |
| − | $out/86400;
| |
| − | }
| |
| − | #-------------------
| |
| − | sub mark_series{
| |
| − |
| |
| − | #identify series of recordings; mark the episodes
| |
| − |
| |
| − | my %namecount;
| |
| − | my $tmp;
| |
| − | my %oldest; # %newest is global as needed later in decide_priorities.
| |
| − |
| |
| − |
| |
| − | #count instances of names, keep newest/oldest
| |
| − | foreach (keys %frecname){
| |
| − | $tmp=×tamp($_);
| |
| − | $fpriority{$_}=$tmp;
| |
| − | $_=$frecname{$_};
| |
| − |
| |
| − | #keep count, oldest, newest for each name found
| |
| − | $namecount{$_}++;
| |
| − | if (exists $newest{$_}) {
| |
| − | if ($tmp < $oldest{$_}) {$oldest{$_}=$tmp};
| |
| − | if ($tmp > $newest{$_}) {$newest{$_}=$tmp};
| |
| − | }else{
| |
| − | $oldest{$_}=$tmp;
| |
| − | $newest{$_}=$tmp;
| |
| − | }
| |
| − | }
| |
| − |
| |
| − | #mark as series if more than 2 episodes and average interval no more than 8 days.
| |
| − | my $count;
| |
| − | my $avinterval;
| |
| − | foreach (keys %namecount){
| |
| − | $count=$namecount{$_};
| |
| − | $avinterval=0;
| |
| − | if ($count>1){$avinterval=($newest{$_}-$oldest{$_})/($count-1)};
| |
| − | if (($count>2) && ($avinterval<8)){
| |
| − | #this is a series
| |
| − | $namecount{$_}=-1;
| |
| − | }
| |
| − | }
| |
| − |
| |
| − | #mark the recordings as series episodes
| |
| − | foreach (keys %frecname){
| |
| − | if ($namecount{$frecname{$_}} <0) {
| |
| − | if ($fstatus{$_}==1){$fstatus{$_}=2};
| |
| − | }
| |
| − | }
| |
| − | }
| |
| − | #--------------------
| |
| − | sub do_action{
| |
| − |
| |
| − | if ($params{'preview'}){return 0};
| |
| − | my $command;
| |
| − | my $qsize;
| |
| − | my $fname;
| |
| − |
| |
| − | #do deletes first
| |
| − | $qsize=@deleteq;
| |
| − | print "\nNow deleting $qsize files\n" if $loglevel>2;
| |
| − | if ($qsize){
| |
| − | foreach $_ (@deleteq){
| |
| − | $command= "rm -f $params{'destdir'}/$_";
| |
| − | system $command;
| |
| − | }
| |
| − | }
| |
| − |
| |
| − | #now do promotions
| |
| − | $qsize=@promoteq;
| |
| − | print "Now promoting $qsize files\n" if $loglevel>2;
| |
| − | if ($qsize==0){return};
| |
| − |
| |
| − | #count the source directories
| |
| − | my $dirct=0;
| |
| − | while (exists $params{'sourcedir'.++$dirct}){
| |
| − | }
| |
| − | $dirct--;
| |
| − |
| |
| − | #do copies
| |
| − | for $fname (@promoteq){
| |
| − | for (1..$dirct){
| |
| − | if ( -e "$params{'sourcedir'.$_}/$fname"){
| |
| − | $command="cp -p $params{'sourcedir'.$_}/$fname $params{'destdir'}";
| |
| − | #print "$command\n";
| |
| − | system $command;
| |
| − | last;
| |
| − | }
| |
| − | }
| |
| − | }
| |
| − |
| |
| − | }
| |
| − | #-------------------
| |
| − | sub decide_action{
| |
| − |
| |
| − | $stats{'promote'}=0;
| |
| − | $stats{'promote size'}=0;
| |
| − | $stats{'demote'}=0;
| |
| − | $stats{'demote size'}=0;
| |
| − |
| |
| − | #queue obsolete files for deletion
| |
| − | my $finished=0;
| |
| − | while ($finished==0){
| |
| − | if (@sorted==0){ #array empty
| |
| − | $finished=1;
| |
| − | }else{
| |
| − | $_=pop @sorted;
| |
| − | if ($fstatus{$_} & 3){ #not obsolete - we overshot!
| |
| − | push @sorted,$_; #put it back
| |
| − | $finished=1;
| |
| − | }elsif ($fstatus{$_} ==12){ #obsolete file for deletion
| |
| − | push @deleteq,$_;
| |
| − | $fstatus{$_} -=8; #demoted
| |
| − | }
| |
| − | }
| |
| − | }
| |
| − |
| |
| − | $stats{'used size'} -=$stats{'obsolete recordings size'};
| |
| − | #report
| |
| − | $stats{'delete obsolete'}=$stats{'obsolete recordings'}; #cleaner name for user
| |
| − | $stats{'delete obsolete size'}=$stats{'obsolete recordings size'};
| |
| − |
| |
| − | #now decide promotions/deletion
| |
| − | my $stale=0; #become stale once we find a secure normal recording
| |
| − | while ($_ = shift @sorted){ #newest
| |
| − | if ($fstatus{$_}==0){ #skip deletions
| |
| − | }elsif ($fstatus{$_} <4){ #an unsaved recording - try to save it
| |
| − | if (&freespace($fsize{$_},$stale)) {
| |
| − | #space made - mark for promotion
| |
| − | if ($stale){ #put in order: oldest fresh, other fresh, newest stale, oldest stale
| |
| − | push @promoteq,$_;
| |
| − | }else{
| |
| − | unshift @promoteq,$_;
| |
| − | }
| |
| − | $fstatus{$_} +=8;
| |
| − | $stats{'promote'}++;
| |
| − | $stats{'promote size'} +=$fsize{$_};
| |
| − | $stats{'used size'} +=$fsize{$_};
| |
| − | }
| |
| − | }elsif ($fstatus{$_} == 13){
| |
| − | #non vip already backed up.
| |
| − | $stale=1;
| |
| − | }
| |
| − | }
| |
| − |
| |
| − | &show_stats('Changes proposed:','delete obsolete','demote','promote');
| |
| − | &show_stats('Proposed final state of partition:','used');
| |
| − | }
| |
| − |
| |
| − | #--------------------
| |
| − | sub freespace{
| |
| − | #free up space by removing oldest secured files
| |
| − | #return 1 if successful, 0 if not
| |
| − | my ($needed,$stale)=@_;
| |
| − |
| |
| − | #check against lower threshold first
| |
| − | if ($needed < ($stats{'threshold size'} - $stats{'used size'})) {return 1};
| |
| − | if ($stale){return 0};
| |
| − |
| |
| − | #now against higher
| |
| − | my $loopstate = -1;
| |
| − | while ($loopstate == -1){
| |
| − | if ($needed < ($stats{'limit size'} - $stats{'used size'})) {
| |
| − | $loopstate=1; #will fit now
| |
| − | }else{
| |
| − | if (@sorted){
| |
| − | my $d = pop(@sorted);
| |
| − | if ($fstatus{$d} >12) {
| |
| − | #demote this one
| |
| − | push @deleteq,$d;
| |
| − | $fstatus{$d} -=8;
| |
| − | $stats{'demote'}++;
| |
| − | $stats{'demote size'} += $fsize{$d};
| |
| − | $stats{'used size'} -= $fsize{$d};
| |
| − | }
| |
| − | }else{
| |
| − | #no files left to remove
| |
| − | $loopstate=0;
| |
| − | }
| |
| − | }
| |
| − | }
| |
| − | $loopstate;
| |
| − | }
| |
| − | #---------------------------
| |
| − | sub opensocket{
| |
| − | print "Opening socket to backend\n" if $loglevel>=4;
| |
| − | unless ($sock = IO::Socket::INET->new(PeerAddr => backendip,
| |
| − | PeerPort => 6543,
| |
| − | Proto => 'tcp',
| |
| − | timeout => 25) ) {
| |
| − | print "cannot open socket to backend.\n";
| |
| − | print "Wrong backend IP address? Backend not running?\n";
| |
| − | exit 0;
| |
| − | }
| |
| − | }
| |
| − | #---------------------------
| |
| − | sub scan_database {
| |
| − |
| |
| − | #probe for protocol version
| |
| − | &opensocket;
| |
| − | print "Probing for protocol version\n" if $loglevel>=4;
| |
| − | my $r= &getreply("MYTH_PROTO_VERSION 1");
| |
| − | unless ($r =~ /^REJECT/){
| |
| − | die "Odd response from MYTH_PROTO_VERSION";
| |
| − | }
| |
| − | my $VersionFound=substr($r,11,);
| |
| − | close($sock);
| |
| − | unless (exists $MythProtocolVersion{$VersionFound}){
| |
| − | die "Mythprotocol version not known or validated";
| |
| − | }
| |
| − |
| |
| − | #now open properly
| |
| − | &opensocket;
| |
| − | $r= &getreply("MYTH_PROTO_VERSION ". $VersionFound .' '. $MythProtocolVersion{$VersionFound});
| |
| − | unless (substr($r,0,6) eq 'ACCEPT') {
| |
| − | die "ERROR: Wrong protocol version: $r";
| |
| − | }
| |
| − |
| |
| − | print "ANNouncing - if no reply, suspect myipaddress\n" if $loglevel>=4;
| |
| − | $r= &getreply('ANN Monitor '.myipaddress . " 0");
| |
| − | unless (substr($r,0,2) eq 'OK') {
| |
| − | die "ERROR: ANN rejected: $r";
| |
| − | }
| |
| − |
| |
| − | print "Getting list of recordings\n" if $loglevel>=4;
| |
| − | $r= &getreply('QUERY_RECORDINGS Unsorted');
| |
| − | my $sep = qr/\[\]:\[\]/;
| |
| − | my @recs = split($sep, $r);
| |
| − |
| |
| − | $stats{'DBrecordings'}=$recs[0]; #no of recordings
| |
| − | print "\nDatabase scan found $recs[0] recordings\n" if $loglevel>1;
| |
| − |
| |
| − | #extract info from recordings
| |
| − | my ($fname, $fstatus);
| |
| − | for (my $i= recstart; $i <= $#recs; $i += reclength) {
| |
| − | (undef, undef, undef, $fname)=split /\//, $recs[$i+recfilename];
| |
| − | $frecname{$fname} = $recs[$i+recname];
| |
| − | $fsize{$fname}=$recs[$i+recsize];
| |
| − | my $flags=$recs[$i+recflags];
| |
| − | if ($recs[$i+recgroup] eq 'Deleted'){ #just deleted
| |
| − | $fstatus{$fname}=0;
| |
| − | }elsif (($flags & flagdeletepending)>0){
| |
| − | $fstatus{$fname}=0; #Delete pending flag (not used?)
| |
| − | }elsif (($flags & flagautoexp)==0){
| |
| − | $fstatus{$fname}=3; #non expirable so vip
| |
| − | }else{
| |
| − | $fstatus{$fname}=1; #expirable
| |
| − | }
| |
| − | if ($loglevel==4){
| |
| − | print "$fname $flags $frecname{$fname}\n";
| |
| − | }
| |
| − | }
| |
| − |
| |
| − | close($sock);
| |
| − | if ($loglevel==4){
| |
| − | print "Scan finishing because loglevel set to 4 for protocol diagnostics.\n";
| |
| − | exit 0;
| |
| − | }
| |
| − | }
| |
| − |
| |
| − | #------------------
| |
| − | sub getreply {
| |
| − | my ($command) = @_;
| |
| − | my ($length, $ret, $bytes, $data);
| |
| − | my $com = length($command). ' ' x (8 - length(length($command))). $command;
| |
| − |
| |
| − | if ($loglevel==4){print "sending $com\n"};
| |
| − | print $sock $com;
| |
| − |
| |
| − | #read length of reply
| |
| − | read($sock, $length, 8);
| |
| − | $length = int($length);
| |
| − |
| |
| − | # Read and return any data that was returned
| |
| − | $ret = '';
| |
| − | while ($length > 0) {
| |
| − | $bytes = read($sock, $data, ($length < 8192 ? $length : 8192));
| |
| − | last if ($bytes < 1); # EOF
| |
| − | # On to the next
| |
| − | $ret .= $data;
| |
| − | $length -= $bytes;
| |
| − | }
| |
| − | print "Reply starts:". substr($ret,0,200)."\n" if $loglevel >=4;
| |
| − | return $ret;
| |
| − | }
| |
| − |
| |
| − |
| |
| − | #-------------------------
| |
| − | sub check_partition{
| |
| − | my $reply = `df $params{'partition'}`;
| |
| − | if (length $reply == 0){die 'cannot find partition'};
| |
| − | my @fields = split /\s+/,$reply;
| |
| − | $stats{'partition size'}=$fields[8]*1024;
| |
| − | $stats{'used size'}=$fields[9]*1024;
| |
| − | $stats{'used'} = sprintf "%2d%%", $stats{'used size'} *100 / $stats{'partition size'};
| |
| − | $stats{'limit size'} = ($stats{'partition size'} * $params{'percent'} /100);
| |
| − | $stats{'limit'}= $params{percent} . '%';
| |
| − | $stats{'size size'}=$stats{'partition size'}; #same but more readable in output
| |
| − | $stats{'threshold'}=$params{'threshold'} .'%';
| |
| − | $stats{'threshold size'}= $params{'threshold'} * $stats{'partition size'}/100;
| |
| − | &show_stats ("Partition $params{'partition'} info", 'size', 'used', 'limit','threshold');
| |
| − | }
| |
| − |
| |
| − | #----------------------------
| |
| − |
| |
| − | sub show_stats{
| |
| − | # print item, number & size
| |
| − | if ($loglevel<2) {return 0};
| |
| − | my @items = @_;
| |
| − | $_=shift @items;
| |
| − | if ($_) {print "\n$_\n"}; #optional heading
| |
| − | my $item_value;
| |
| − | while (@items){
| |
| − | $_=shift @items;
| |
| − | if (exists $stats{$_}) {
| |
| − | if ($_ eq 'used'){
| |
| − | #update used percentage
| |
| − | $stats{'used'} = sprintf "%2d%%", $stats{'used size'} *100 / $stats{'partition size'};
| |
| − | }
| |
| − | $item_value=$stats{$_};
| |
| − | #show item and number
| |
| − | if ($item_value =~/%/){
| |
| − | printf "%7s",$item_value;
| |
| − | }else{
| |
| − | printf "%7d",$item_value;
| |
| − | }
| |
| − | }else{
| |
| − | print " ";
| |
| − | }
| |
| − | printf " %-25s",$_;
| |
| − |
| |
| − | #show size if present
| |
| − | $_ .= ' size';
| |
| − | if (exists $stats{"$_"}) {
| |
| − | $item_value= $stats{$_};
| |
| − | printf "%7.2fG",$item_value/$gig;
| |
| − | }
| |
| − | print "\n";
| |
| − | }
| |
| − | }
| |
| − | #------------
| |
| − | sub showall{
| |
| − | #show all recordings
| |
| − | # print "\nfile status is Deleted, Secure, Insecure, Promote or Demote followed by vip (non expirable), series or deleted.\n";
| |
| − | print "\nAll files (priority order) Status Size Name (if known)\n";
| |
| − | print "-----------------------------------------------------------\n";
| |
| − | foreach (@sorted2){
| |
| − | printf "$_ %9s %3.1fGb $frecname{$_}\n",&statusname($fstatus{$_}),$fsize{$_}/$gig;
| |
| − | }
| |
| − | }
| |
| − | #------------
| |
| − | sub scansources{
| |
| − | #scan source directories, report only.
| |
| − | $stats{'missing'}=0;
| |
| − | $stats{'found'}=0;
| |
| − |
| |
| − | my $i=0;
| |
| − | while (exists $params{'sourcedir'.++$i}){
| |
| − | &scandir($params{'sourcedir'.$i},0);
| |
| − | }
| |
| − |
| |
| − | #counts consistent with d/base?
| |
| − | $i=$stats{'DBrecordings'}-$stats{'found'};
| |
| − | if ($i<0){$i=-$i};
| |
| − | $i += $stats{'missing'};
| |
| − | if (($i>0) && ($loglevel>1)) {
| |
| − | print "\nThere were $i database inconsistencies.\n";
| |
| − | print "Suggest using find_orphans.py\n";
| |
| − | }
| |
| − | }
| |
| − | #-------------
| |
| − | sub scandir{
| |
| − | my ($dir, $destination)=@_;
| |
| − | my ($size, $category);
| |
| − | #scan a folder, show stats for it
| |
| − |
| |
| − | $stats{'vip recordings'}=0;
| |
| − | $stats{'vip recordings size'}=0;
| |
| − | $stats{'expirable recordings'}=0;
| |
| − | $stats{'expirable recordings size'}=0;
| |
| − | $stats{'obsolete recordings'}=0;
| |
| − | $stats{'obsolete recordings size'}=0;
| |
| − |
| |
| − | $stats{'series recordings'}=0;
| |
| − | $stats{'series recordings size'}=0;
| |
| − | $stats{'noname'}=0;
| |
| − |
| |
| − | opendir DH,$dir or die "Cannot open $dir: $!";
| |
| − | foreach $_ (readdir DH) {
| |
| − | if (/^\d{4}_\d{14}\.mpg$/) {
| |
| − | if (exists $fstatus{$_}) {
| |
| − | $stats{'found'}++;
| |
| − | if ($destination){
| |
| − | $fstatus{$_} +=12;
| |
| − | }
| |
| − | }else{
| |
| − | $stats{'missing'}++;
| |
| − | if ($destination){
| |
| − | $fsize{$_}= -s "$dir\/$_";
| |
| − | $fstatus{$_} = 12;
| |
| − | $frecname{$_}='??';
| |
| − | $stats{'noname'}++;
| |
| − | }
| |
| − | }
| |
| − |
| |
| − | #collect stats
| |
| − | if (exists $fstatus{$_}){
| |
| − | $size=$fsize{$_};
| |
| − | $_=($fstatus{$_} & 3);
| |
| − | $category=qw/obsolete expirable series vip/[$_];
| |
| − | $stats{$category.' recordings'}++;
| |
| − | $stats{$category.' recordings size'} += $size;
| |
| − | }
| |
| − | }
| |
| − | }
| |
| − | closedir DH;
| |
| − |
| |
| − | #summary
| |
| − | $stats{'--- total ---'}=$stats{'series recordings'}+
| |
| − | $stats{'expirable recordings'} + $stats{'vip recordings'} + $stats{'obsolete recordings'};
| |
| − | $stats{'--- total --- size'}=$stats{'series recordings size'}
| |
| − | +$stats{'expirable recordings size'} + $stats{'vip recordings size'} + $stats{'obsolete recordings size'};
| |
| − | $_=$destination?'Destination':'Source';
| |
| − | &show_stats("$_ directory $dir",'vip recordings', 'series recordings', 'expirable recordings','obsolete recordings','--- total ---');
| |
| − | }
| |
| − |
| |
| − | #------------
| |
| − | sub statusname{
| |
| − | #return text showing status
| |
| − | (my $st)=@_;
| |
| − | my @ftype=('Del',' ','Ser','Vip');
| |
| − | my $st2=($st & 12)/4;
| |
| − | qw/Ins Dem Pro Sec/[$st2] .' '. $ftype[$st & 3];
| |
| − | }
| |
| − |
| |
| − | #------------------
| |
| − | sub parse_command_line{
| |
| − | if (scalar @ARGV){
| |
| − | my @argcopy=@ARGV;
| |
| − | while (@argcopy){
| |
| − | $_ = shift @argcopy;
| |
| − | if (/^--preview$|^-p$/) {
| |
| − | $params{'preview'}=1;
| |
| − |
| |
| − | }elsif (/^--loglevel$/) {
| |
| − | my $bad=1;
| |
| − | if (scalar @argcopy){
| |
| − | $loglevel=shift @argcopy;
| |
| − | if ($loglevel =~/\d/){
| |
| − | if (($loglevel>=0) && ($loglevel<5)) {$bad=0};
| |
| − | }
| |
| − | }
| |
| − | if ($bad){
| |
| − | print "bad loglevel needs 0 to 4\n";
| |
| − | exit 0;
| |
| − | }
| |
| − | }elsif (/^--help$|^-h$/){
| |
| − | &givehelp;
| |
| − | exit 0;
| |
| − | }elsif (/^--delete$/){
| |
| − | #recording delete event
| |
| − | $_ = "$params{'destdir'}/" . shift @argcopy;
| |
| − | if ( -e $_){system "rm -f $_"};
| |
| − | exit 0;
| |
| − | }else{
| |
| − | print "parameter $_ not recognised. Try $0 --help\n";
| |
| − | exit 0;
| |
| − | }
| |
| − | }
| |
| − | }
| |
| − | if ($loglevel){
| |
| − | $_= `date +%F" "%T`;
| |
| − | chomp;
| |
| − | print "\n$_ $0 @ARGV\n";
| |
| − | print "Version ". VERSION . ". running with loglevel=$loglevel, preview=". qw/no yes/[$params{'preview'}] ."\n";
| |
| − | }
| |
| − |
| |
| − | }
| |
| − | #------------
| |
| − | sub givehelp{
| |
| − |
| |
| − | print "
| |
| − |
| |
| − | NAME: autobackup.pl
| |
| − |
| |
| − | SYNOPSIS: autobackup.pl [options]
| |
| − |
| |
| − | DESCRIPTION:
| |
| − |
| |
| − | autobackup.pl selects a subset of mythtv recordings
| |
| − | and makes a backup of them to a destination partition which
| |
| − | is typically smaller than the total size of all recordings
| |
| − | and which is on a separate disk. It allows recovery of
| |
| − | service with a 'useful' set of recordings in case of
| |
| − | primary disk failure.
| |
| − |
| |
| − | It should be augmented by appropriate database and system
| |
| − | backups.
| |
| − |
| |
| − | OPTIONS:
| |
| − |
| |
| − | --preview or -p
| |
| − | to inhibit file copy/deletes. This shows what
| |
| − | action would be taken with a full run.
| |
| − |
| |
| − | --loglevel n to set logging levels.
| |
| − | 1 for calling info,
| |
| − | 2 for stats,
| |
| − | 3 for a recordings list
| |
| − | 4 for protocol diagnostics
| |
| − | Default is 3.
| |
| − |
| |
| − | --help or -h this text
| |
| − |
| |
| − | --delete <filename>
| |
| − | deletes file from destination directory. For use with
| |
| − | recording delete system event, though use optional.
| |
| − |
| |
| − | DETAILS:
| |
| − |
| |
| − | autobackup.pl is intended to be run as a regular job at system
| |
| − | closedown when the system is otherwise idle. It checks
| |
| − | the destination partition to determine how full it is,
| |
| − | then scans the database and the source and destination
| |
| − | directories to check the state of all recordings.
| |
| − | It is then in a state to identify series recordings,
| |
| − | allocate priorities and determine the action for each file.
| |
| − |
| |
| − | Files are selected for backup in date/time order (newest
| |
| − | first) but:
| |
| − |
| |
| − | - recordings marked as non-expirable have a 20 year
| |
| − | priority boost
| |
| − |
| |
| − | - recordings which are recognised as episodes of a series
| |
| − | can be bunched together with the latest episode
| |
| − | and/or have a number of days added as a boost.
| |
| − | The author uses bunching with zero days boost.
| |
| − |
| |
| − | Three or more recordings with the same name and an average
| |
| − | interval between them of less than 8 days are deemed to
| |
| − | be a series.
| |
| − |
| |
| − | Files will be promoted from the head of the list, and files
| |
| − | demoted as necessary from the end in order to prevent
| |
| − | over-filling the partition.
| |
| − |
| |
| − | PARTITION LIMITS
| |
| − |
| |
| − | New recordings will be promoted whilst observing the partition
| |
| − | limit of $params{'percent'}%. Older recordings will only be considered if the
| |
| − | partition is below a partition threshold of $params{'threshold'}% full.
| |
| − | This is only likely happen after a spate of manual deletions.
| |
| − |
| |
| − | The two limits prevent a recording from falling in and out
| |
| − | of favour as higher priority recordings are created and removed.
| |
| − | Threshold should be a few days worth of recordings below limit.
| |
| − |
| |
| − | DELETED RECORDINGS
| |
| − |
| |
| − | Recordings can optionally be deleted from the destination directory
| |
| − | with the RecordingDelete system event mechanism by calling this program
| |
| − | with --delete %FILE%. This will remove the file more quickly.
| |
| − |
| |
| − | However, such files will be routinely deleted by this program if the event
| |
| − | system is not used.
| |
| − |
| |
| − | Recordings which have been deleted from the database but still
| |
| − | remain on the destination partition no longer have their name in
| |
| − | the database. In order to give these a name in listings, the script
| |
| − | writes a list of today's recordings to the file to enable the names
| |
| − | to be established next day. The file is
| |
| − | $params{'filelist'}
| |
| − |
| |
| − | WORKING PARAMETERS
| |
| − |
| |
| − | See the parameters (\%params) at the head of the program defining
| |
| − | parameters such as the destination partition, percentage used,
| |
| − | source and destination directories, default logging level, series
| |
| − | action, threshold setting and name of recordings list.
| |
| − |
| |
| − | LOGGING
| |
| − |
| |
| − | If log files are required then they need to be redirected from STDOUT
| |
| − | and STDERR and rotated as necessary by a calling script eg autobackup.sh
| |
| − |
| |
| − |
| |
| − | DATABASE BACKUPS
| |
| − |
| |
| − | The perl script has a sister routine autobackup.sh which
| |
| − | takes a database backup and triggers this script at last
| |
| − | closedown of the day. See autobackup.sh.
| |
| − |
| |
| − |
| |
| − | DEVELOPMENT REGIME
| |
| − |
| |
| − | The script has been developed and tested in the UK on a
| |
| − | Mythbuntu 12.04 dedicated frontend/backend system with
| |
| − | ACPI wakeup, DVB-T receivers, a single directory for
| |
| − | recordings, and a local time close to or equal to GMT.
| |
| − |
| |
| − | A 500Gb disk holds root, swap and backup recording partitions.
| |
| − | A 2Tb drive holds emergency root and swap and the primary
| |
| − | recording partition /var/lib/mythtv.
| |
| − |
| |
| − | Assumptions may well have been inadvertently made which are
| |
| − | not valid in all circumstances and the author can accept
| |
| − | no responsibility for the results of this script.
| |
| − | In particular, this system has been developed with version
| |
| − | 72 of mythtv protocol and it will need validating carefully
| |
| − | against other implementations.
| |
| − |
| |
| − | To use with other versions you will need to add a new version
| |
| − | and its key in \%MythProtocolVersion and test thoroughly
| |
| − | with --loglevel 4 and then with --preview.
| |
| − |
| |
| − |
| |
| − | AUTHOR:
| |
| − |
| |
| − | Written by Phil Brady, November 2012.
| |
| − |
| |
| − |
| |
| − | COPYRIGHT
| |
| − |
| |
| − | Copyright © 2012 Phil Brady.
| |
| − | License GPLv3+: GNU GPL version 3 or later
| |
| − | See http://gnu.org/licenses/gpl.html.
| |
| − |
| |
| − | This is free software: you are free to change and redistribute
| |
| − | it. There is NO WARRANTY, to the extent permitted by law.
| |
| − |
| |
| − | ";
| |
| − |
| |
| − | exit 0;
| |
| − | }
| |
| − |
| |
| − |
| |
| − | </pre>}}
| |
| − |
| |
| − | [[Category:Perl_Scripts]]
| |
| − | [[Category:Management Scripts]]
| |
