WebSVN – sysadmin_scripts – Diff – /trunk/archiveIMAP/archiveIMAP

 #    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, see <http://www.gnu.org/licenses/>.
+#
+#    for required libraries
+#    apt-get -y install libnet-imap-simple-ssl-perl libyaml-tiny-perl libhash-merge-simple-perl libclone-perl
 use strict;
 use warnings;
 use Net::IMAP::Simple; # libnet-imap-simple-ssl-perl
 use POSIX; # to get floor and ceil
+use YAML::Tiny; # apt-get libyaml-tiny-perl under debian
+use Clone 'clone'; # libclone-perl
+use Hash::Merge::Simple qw/ merge clone_merge /; # libhash-merge-simple-perl
-#use Data::Dumper;
+use Data::Dumper;
 # globals
-my $CONFIG_FILE_NAME = 'archiveIMAP.cfg';
+my $CONFIG_FILE_NAME = 'archiveIMAP.yaml';
-my $server = 'localhost'; # used if not specified in definition
+# the default values for everything. These are overridden
+# by default values in the conf file (.yaml) or by individual
+# accounts entries.
+my $config = {
+   'default' => {
+      # where the mail is going to
+      'target' => {
+                  # these have no defaults. They should be in the configuration file
+                  # 'password' => 'password',
+                  # 'username' => 'username',
-# Following are added to ignore in definition in account (%accounts)
+                  # hierarchy can be any combination of <path>, <month> and <year>
+                  'hierarchy' => '<path>',
+                  # default target server
+                  'server' => 'localhost',
+                 },
+      # where the mail is coming from
+      'source' => {
-my @ignore = ( 'Deleted Messages','Drafts','Junk E-mail','Junk','Trash' );
+                  # these have no defaults. They should be in the configuration file
+                  # 'password' => 'password',
+                  # 'username' => 'username',
+                  # Anything older than this is archived
-# these are folders we may want to copy, but we never want to delete
+                  # number of days unless followed by 'M' or 'Y', in which case it is
+                  # multiplied by the number of days in a year (365.2425) or days in a month (30.5)
-my @systemFolders = ('Outbox','Sent Items','INBOX','Inbox');
+                  # may be a float, ie 1.25Y is the same as 15M
+                  'age' => '1Y',
+                  # if set to 1, any folders emptied out will be deleted EXCEPT system folders
-my $deleteEmptyFolders = 1;
+                  'deleteEmptyFolders' => 0,
+                  # default source server
+                  'server' => 'localhost',
+                  # these folders are considered system folders and never deleted, case insensitive
+                  'system' => [
+                                 'Outbox',
+                                 'Sent Items',
+                                 'INBOX'
+                              ],
+                  # these folders are ignored, ie not processed at all. Case insensitive
+                  'ignore' => [
+                                 'Deleted Messages',
+                                 'Drafts',
+                                 'Junk E-mail',
+                                 'Junk',
+                                 'Trash'
+                               ],
+                  # if 1, after successful copy to target, remove from source
-my $deleteOnSuccess = 1;
+                  'deleteOnSuccess' => 0
+               },
-my %accounts;  # this must be configured in archiveIMAP.cfg. See sample.
+      # if 1, does a dry run showing what would have happened
+      'testing' => 0,
+      # if 0, will not be processed
+      'enabled' => 1,
+   }
+   };
+#
 # find where the script is actually located as cfg should be there
+#
 sub getScriptLocation {
 # Read the configuration file from current location
 # and return it as a string
+#
 sub readConfig {
    my $scriptLocation = &getScriptLocation();
-   my $return = '';
    if ( -e "$scriptLocation/$CONFIG_FILE_NAME" ) {
-      open CFG,"<$scriptLocation/$CONFIG_FILE_NAME" or die "Could not read $scriptLocation/$CONFIG_FILE_NAME: $!\n";
+      my $yaml = YAML::Tiny->read( "$scriptLocation/$CONFIG_FILE_NAME" );
+      # use clone_merge to merge conf file into $config
+      # overwrites anything in $config if it exists in the config file
-      $return = join ( '', <CFG> );
+      $config = clone_merge( $config, $yaml->[0] );
-      close CFG;
+      return 1;
+   }
+   return 0;
+}
+# merges default into current account, overwriting anything not defined in account with
+# value from default EXCEPT arrays labeled in @tags, which will be merged together.
+sub fixupAccount {
+   my ( $default, $account ) = @_;
+   # these arrays, part of source, will be appended together instead of being overwritten
+   my @tags = ( 'ignore', 'system' );
+   # merge the tags in question. NOTE: they can only be in source
+   foreach my $tag ( @tags) {
+      if ( $default->{'source'}->{$tag} && $account->{'source'}->{$tag} ) {
+         my @j = ( @{$default->{'source'}->{$tag}}, @{$account->{'source'}->{$tag}} );
+         $account->{'source'}->{$tag} = \@j;
+      }
+   }
+   # now, merge account and default, with account taking precedence.
+   return  clone_merge(  $default, $account );
+   #my $c = clone_merge(  $default, $account );
-   return $return;
+   #return $c;
+}
+#
 # Open an IMAP connection
+#
    return $imap;
+}
+#
 # returns a string in proper format for RFC which is $age days ago
+# $age is a float, possibly followed by a single character modifier
+#
 sub getDate {
    my $age = shift;
+   # allow modifier to age which contains 'Y' (years) or 'M' (months)
+   # Simply set multiplier to the correct value, then multiply the value
+   $age = lc( $age );
+   if ( $age =~ m/([0-9.]+)([a-z])/ ) {
+      my $multiplier = ($2 == 'y' ? 365.2425 : ( $2 == 'm' ? 30.5 : MAXINT) );
+      $age = floor( $1 * $multiplier);
+   }
    my @months = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
    my @now = localtime(time - 24 * 60 * 60 * $age);
    $now[4] = @months[$now[4]];
    $now[5] += 1900;
    my $date = sprintf( "%d-%s-%d", $now[3],$now[4],$now[5] ) ; # '1-Jan-2014';
    print "\n\t\tDeleting empty folder $folder";
    $sourceAccount->folder_unsubscribe($folder);
    $sourceAccount->delete_mailbox( $folder );
+}
-#
-# If folder has messages that match the criteria, move them to target
-# creates the target folder if necessary
-#
-sub processFolder {
-   my ( $sourceAccount, $targetAccount, $folder, $dateBefore, $sourceDelimiter, $targetDelimiter, $deleteOnSuccess ) = @_;
-   my $numMessages = 0;
-   $sourceAccount->expunge_mailbox( $folder ); # clean it up so we don't copy deleted messages
-   $sourceAccount->select( $folder ) or die "Could not connect to folder $folder\n"; # move into the correct folder for the source
-   my @ids = $sourceAccount->search_sent_before( $dateBefore ); # use sent_before to get the sent date from message
-#   print join( "\n\t\t\t", @ids ) . "\n";
-   return 0 unless @ids; # we have nothing to copy, so exit
-   if ( $sourceDelimiter ne $targetDelimiter ) { # different delimiters, so we have to change them in the folder def
-      # they may contain meta chars, so escape them. We can use \Q \E in the pattern to match, but the
-      # second part of the s/// will substitute literal EXCEPT for the delimiter and the dollar sign
-      # I'm escaping the double quote (what I'm using for the delimiter) "just in case" but I'm not doing
-      # the dollar sign, so this will fail, fail, fail if there is an issue there.
-      my $escapedTargetDelimiter = $targetDelimiter eq '"' ? '\\' .  $targetDelimiter : $targetDelimiter;
-      $folder =~ s"\Q$sourceDelimiter\E"$escapedTargetDelimiter"g;
-   }
-   if ( $targetAccount->select( $folder ) || &makeFolder( $targetAccount, $folder, $targetDelimiter ) ) {
-      foreach my $id ( @ids ) {
-         my @flags = $sourceAccount->msg_flags( $id );
-         my $message = $sourceAccount->get( $id ) or die $sourceAccount->errstr;
-         if ( $targetAccount->put( $folder, $message, @flags ) ) {
-            $sourceAccount->delete( $id ) if ( $deleteOnSuccess ) ;
-            $numMessages++;
-         } else {
-            die "Could not write to target, aborting\n$targetAccount->errstr\n";
-         }
-      }
-   } else {
-      warn "\t\t$folder not found in target and could not create it\n";
-   }
-   return $numMessages;
-}
-# this is an alternative to maintaining the hierarchy of the original system.
-# instead, it will take
-sub processFolderByDate {
-   my ( $sourceAccount, $targetAccount, $folder, $targetFormat, $dateBefore, $sourceDelimiter, $targetDelimiter, $deleteOnSuccess ) = @_;
-   my $numMessages = 0;
-   $sourceAccount->expunge_mailbox( $folder ); # clean it up so we don't copy deleted messages
-   $sourceAccount->select( $folder ) or die "Could not connect to folder $folder\n"; # move into the correct folder for the source
-   my @ids = $sourceAccount->search_sent_before( $dateBefore ); # use sent_before to get the sent date from message
-#   print join( "\n\t\t\t", @ids ) . "\n";
-   return 0 unless @ids; # we have nothing to copy, so exit
-   if ( $sourceDelimiter ne $targetDelimiter ) { # different delimiters, so we have to change them in the folder def
-      # they may contain meta chars, so escape them. We can use \Q \E in the pattern to match, but the
-      # second part of the s/// will substitute literal EXCEPT for the delimiter and the dollar sign
-      # I'm escaping the double quote (what I'm using for the delimiter) "just in case" but I'm not doing
-      # the dollar sign, so this will fail, fail, fail if there is an issue there.
-      my $escapedTargetDelimiter = $targetDelimiter eq '"' ? '\\' .  $targetDelimiter : $targetDelimiter;
-      $folder =~ s"\Q$sourceDelimiter\E"$escapedTargetDelimiter"g;
-   }
-   if ( $targetAccount->select( $folder ) || &makeFolder( $targetAccount, $folder, $targetDelimiter ) ) {
-      foreach my $id ( @ids ) {
-         my @flags = $sourceAccount->msg_flags( $id );
-         my $message = $sourceAccount->get( $id ) or die $sourceAccount->errstr;
-         if ( $targetAccount->put( $folder, $message, @flags ) ) {
-            $sourceAccount->delete( $id ) if ( $deleteOnSuccess ) ;
-            $numMessages++;
-         } else {
-            die "Could not write to target, aborting\n$targetAccount->errstr\n";
-         }
-      }
-   } else {
-      warn "\t\t$folder not found in target and could not create it\n";
-   }
-   return $numMessages;
-}
-#
-# main processing loop to handle one account
+# main process loop to handle one account
+#
 sub processAccount {
-   my ( $source, $target, $age, $ignore, $deleteOnSuccess, $deleteEmptyFolders, $hierarchy ) = @_;
-   $heirarchy = '' unless $hierarchy;
+   my $account = shift;
-   my $date = getDate( $age );
+   my $date = &getDate( $age );
    print "\t" . ( $deleteOnSuccess ? 'Moving' : 'Copying' ) . " all messages before $date\n";
    # open and log into both source and target, and get the separator used
    my $sourceAccount = &openIMAPConnection( $$source{'server'}, $$source{'username'}, $$source{'password'} );
    my $targetAccount = &openIMAPConnection( $$target{'server'}, $$target{'username'}, $$target{'password'} );
    my $count = 0; # count the number of messages processed
    my $processedCount = 0; # count the number of folders processed
    foreach my $folder ( @$folderList ) {
       print "\t$folder";
       my $messages;
-      if ( $heirarchy ) {
-         $messages = &processFolderByDate( $sourceAccount, $targetAccount, $folder, $hierarchy, $date, $$source{'separator'}, $$target{'separator'}, $deleteOnSuccess );
-      } else {
-         $messages = &processFolder( $sourceAccount, $targetAccount, $folder, $date, $$source{'separator'}, $$target{'separator'}, $deleteOnSuccess );
+      $messages = &processFolder( $sourceAccount, $targetAccount, $folder, $date, $$source{'separator'}, $$target{'separator'}, $deleteOnSuccess );
-      }
-      $sourceAccount->expunge_mailbox( $folder );
+      $TESTING ? print "Would expunge $folder\n" : $sourceAccount->expunge_mailbox( $folder );
       # delete folder if empty and client has requested it.
-      &deleteAFolder( $sourceAccount, $folder, $$source{'separator'}, $$source{'systemfolder'} ) if ( $deleteEmptyFolders );
+      ( $TESTING ? print "Would delete $folder\n" : &deleteAFolder( $sourceAccount, $folder, $$source{'separator'}, $$source{'systemfolder'} ) ) if ( $deleteEmptyFolders );
       print "\n\t\t$messages processed\n";
       $count += $messages;
       $processedCount++;
       # next line used only for testing. Dies after 5 folders on first account
       # last if $processedCount > 5;
    $sourceAccount->quit;
    $targetAccount->quit;
    return $count;
+}
 #######################################################################
 #                   Main                                              #
 #######################################################################
 # read and evaluate configuration file
-if ( my $config = readConfig() ) {
+&readConfig() || die "could not load config file\n";
-   eval $config;
+#print Dumper( $config ); die;
-   die "Error in configuraration file $CONFIG_FILE_NAME\n$@" if $@;
+foreach my $account ( keys %{$config->{'accounts'}} ) {
-} else {
-   die "Configurastion file $CONFIG_FILE_NAME must be located in script directory\n";
+    $config->{'accounts'}->{$account} = &fixupAccount( $config->{'default'}, $config->{'accounts'}->{$account} );
+}
+#print Dumper( $config ) ; die;
+# just a place to gather some stats
 my %processed;
 $processed{'Accounts'} = 0;
 $processed{'Messages'} = 0;
+# grab only the accounts for simplicity
+my $accounts = $config->{'accounts'};
+# now, process each in turn
-foreach my $account ( keys %accounts ) {
+foreach my $account ( keys %$accounts ) {
    # talk to user
    print "Processing account $account\n";
-   # Set some defaults from globals if they were not defined
+   # do the account. This is the main worker bee
-   $accounts{$account}{'source'}{'server'} = $server unless exists( $accounts{$account}{'source'}{'server'} );
+   $accounts->{$account}->{'processed'} = &processAccount( $accounts->{$account} );
-   $accounts{$account}{'target'}{'server'} = $server unless exists( $accounts{$account}{'target'}{'server'} );
-   $accounts{$account}{'deleteOnSuccess'} = $deleteOnSuccess unless exists $accounts{$account}{'deleteOnSuccess'};
-   $accounts{$account}{'deleteEmptyFolders'} = $deleteEmptyFolders unless exists $accounts{$account}{'deleteEmptyFolders'};
-   if ( exists $accounts{$account}{'ignore'} ) {
-      foreach my $element ( @ignore ) {
-         push $accounts{$account}{'ignore'}, $element;
-      }
-   } else {
-      $accounts{$account}{'ignore'} = \@ignore;
-   }
-   if ( exists $accounts{$account}{'source'}{'systemFolders'} ) {
-      foreach my $element ( @systemFolders ) {
-         push $accounts{$account}{'source'}{'systemFolders'}, $element;
-      }
-   } else {
-      $accounts{$account}{'source'}{'systemFolders'} = \@systemFolders;
-   }
-   # do the account
-   $accounts{$account}{'processed'} =
-            &processAccount(
-                     $accounts{$account}{'source'},
-                     $accounts{$account}{'target'},
-                     $accounts{$account}{'age'},
-                     $accounts{$account}{'ignore'},
-                     $accounts{$account}{'deleteOnSuccess'},
-                     $accounts{$account}{'deleteEmptyFolders'}
-                     );
-   print "Done, $accounts{$account}{'processed'} messages copied\n";
+   print "Done, $accounts->{$account}->{'processed'} messages copied\n";
    $processed{'Accounts'}++;
-   $processed{'Messages'} += $accounts{$account}{'processed'};
+   $processed{'Messages'} += $accounts->{$account}->{'processed'};
 } # foreach loop
 print "$processed{'Accounts'} accounts processed, $processed{'Messages'} messages\n";
 ;

Subversion Repositories sysadmin_scripts

(root)/trunk/archiveIMAP/archiveIMAP – Rev 38 → 40