CentOS LAMP 환경의 courier maildir 폴더 스크립트

결국 아무런 반응도 없었고, 문제를 해결할 단서도 많지 않았습니다.

저는 현재 모든 계정을 통과하여 30일이 지난 메시지를 다음 구조의 폴더로 이동하는 Perl 스크립트를 사용하고 있습니다.

/home/account/domain.com/mail/mailbox/.00 보관함 Inbox.2012.08 8월 /home/account/domain.com/mail/mailbox/.00 보관함 Sent.2012.08 8월

#!/usr/bin/perl
# encoding: utf-8
#

use strict;
use warnings;

use User::pwent;
use POSIX qw( strftime );
use YAML::Any qw( LoadFile );
use File::Copy;
use File::Basename;
use File::Spec::Functions;

our $USER    = q(the-account-user-name);
our $LIMIT   = 100000;
our $AGE     = 30;
our $STAGGER = 1;

our $PW      = getpwnam( $USER );
our $UID     = $PW->uid;
our $GID     = $PW->gid;
our $HOME    = $PW->dir;
our $ERRORS  = 0;
our $NOW     = time;

$AGE and $AGE *= 24 * 60 * 60;

our $stored_list = LoadFile( "$HOME/.archived-emails" );
our @EMAILS = @$stored_list;


sub shell_escape {
  my $token = shift;
  if ( length( $token ) == 0 ) { return "''"; }
  $token =~ s/([^A-Za-z0-9_\-\.,:\/@\n])/\\$1/g;
  $token =~ s/\n/'\n'/g;
  return $token;
}
sub folder_to_dir {
  my ( $base, $folder ) = @_;

  if ( $folder eq "INBOX" ) {
    return $base;
  } else {
    $folder =~ s/^INBOX(?=\.)//;
    return catfile( $base, $folder );
  }
}

sub email_to_dir {
  my ( $address ) = @_;

  my ( $mail_user, $domain ) = split( /@/, $address, 2 );
  return "$HOME/mail/$domain/$mail_user";
}

sub create_mail_dir {
  my ( $base, $name ) = @_;
  my $full = "$base/.$name";
  unless ( -d "$full/cur" ) {
    system( "/usr/lib/courier-imap/bin/maildirmake", '-f', $name, $base );
    chown $UID, $GID, "$base/.$name", glob( "$base/.$name/*" );
  }
  return $full;
}


sub subscribe {
  my ( $base, @names ) = @_;
  my $subscribed = "$base/courierimapsubscribed";

  my %folder_set = map { $_ => 1 } map { "INBOX.$_" } @names;
  my $f;

 if ( -f $subscribed ) {
    open $f, "< $subscribed";
    while ( <$f> ) {
      chomp;
      /^\s*$/ and next;
      s(^\s+|\s+$)()g;
      $folder_set{$_} = 1;
    }
    close $f;
  }

  open( $f, "> $subscribed" );
  for my $folder_name ( sort keys %folder_set ) {
    print $f "$folder_name\n";
  }
  close $f;

  chown $UID, $GID, $subscribed;
  chmod 0644, $subscribed;
}


sub archive {
  my ( $email, @folders ) = @_;
  my $root = email_to_dir $email;

  unless ( -d $root ) {
    print "$email: Skipping as it does not appear to be an existing e-mail\n";
    $ERRORS++;
    return;
  }

  print "$email: Archiving\n";
  for my $folder_name ( @folders ) {
#   print "folder_name $folder_name \n";

    my $archive = $folder_name eq "INBOX.Sent" ? "00 Archive Sent" : "00 Archive $folder_name" || $folder_name eq "INBOX" ? "00 Archive Inbox" : "00 Archive $folder_name";
    my $dir     = folder_to_dir( $root, $folder_name );

 if ( -d "$dir/cur" ) {
      my %subscribed   = ( "$archive" => 1 );
      my $archive_base = create_mail_dir $root, $archive;

      my @targets = grep { -d } map { "$dir/$_" } qw( cur new );
      my $find_cmd = join( ' ', map { shell_escape( $_ ) } ( "find", @targets, "-type", 'f' ) );

      my @files;
      for ( `$find_cmd` ) {
        chomp;

        my $file = basename( $_ );
        if ( $file =~ /^(\d+)\./ ) {
          my $timestamp = 0 + $1;
          my $path      = $_;

          push @files, [ $timestamp, $path ];
        }
      }

      if ( @files ) {
        my ( @move_list, @stay_list );
        @files     = sort { $b->[ 0 ] <=> $a->[ 0 ] } @files;
        @stay_list = @files;

        if ( $LIMIT and @stay_list > $LIMIT ) {
          @move_list = @stay_list[ $LIMIT ... $#stay_list ];
          @stay_list = @stay_list[ 0 ... $LIMIT - 1 ];
        }

        if ( $AGE ) {
          AGE_LOOP:
            while ( @stay_list ) {
              my $oldest_entry = $stay_list[ $#stay_list ];
              if ( $NOW - $oldest_entry->[ 0 ] > $AGE ) {
                push @move_list, pop( @stay_list );
              } else {
                last AGE_LOOP;
                            }
            }
        }

        for my $entry ( @move_list ) {
          my ( $timestamp, $path ) = @$entry;
          my $archive_path;

          if ( $STAGGER ) {
            my $date         = strftime( "%Y.%m %B", localtime( $timestamp ) );
            $archive_path    = create_mail_dir( $root, "$archive.$date" );
            $subscribed{"$archive.$date"} = 1;
          } else {
            $archive_path = $archive_base;
          }
          move( $path, "$archive_path/cur" ) or warn( $! );
#   print "archive path $archive_path \n";
        }

        my $c = scalar @move_list;
        print "  - $folder_name: moved \e[32m$c\e[0m messages to archive folders\n";
      } else {
        print "  - $folder_name: found no messages to archive\n";
      }

      if ( my @subs = keys %subscribed ) {
        subscribe $root, @subs;
      }

    } else {
      print "  - $folder_name: skipping as this does not appear to be a valid mail folder\n";
    }
  }
}


for my $email ( @EMAILS ) {
  archive $email, "INBOX", "INBOX.Sent";
}

exit $ERRORS;

이 스크립트에서 내가 마음에 들지 않는 유일한 점은 이동된 메일의 ctime(UNIX epoch 시간)을 현재 시간으로 변경한다는 것입니다. 적어도 mtime은 변경되지 않았습니다.