bin/sendmail.import

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Term::Query qw(query);
   5 use Net::SCP qw(iscp);
   6 use FS::UID qw(adminsuidsetup datasrc);
   7 use FS::Record qw(qsearch qsearchs);
   8 ##use FS::svc_acct_sm;
   9 #use FS::svc_domain;
  10 #use FS::domain_record;
  11 use FS::svc_acct;
  12 ##use FS::part_svc;
  13 use FS::svc_forward;
  14 use FS::svc_domain;
  15
  16 my $user = shift or die &usage;
  17 adminsuidsetup $user;
  18
  19 #$FS::svc_Common::noexport_hack = 1;
  20 #$FS::domain_record::noserial_hack = 1;
  21
  22 use vars qw($defaultdomain);
  23 $defaultdomain = '295.ca';
  24
  25 use vars qw(@svcpart $forward_svcpart);
  26 @svcpart = qw( 2 4 );
  27 $forward_svcpart = 7;
  28
  29 use vars qw($spooldir);
  30 $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/sendmail";
  31 mkdir($spooldir, 0755) unless -d $spooldir;
  32
  33 print "\n\n", <<END;
  34 Enter the location and name of your Sendmail aliases file, for example
  35 "mail.isp.com:/etc/mail/aliases"
  36 END
  37 my($aliases)=&getvalue(":");
  38
  39 use vars qw($aliases_machine $aliases_prefix);
  40 $aliases_machine = (split(/:/, $aliases))[0];
  41 $aliases_prefix = "$spooldir/$aliases_machine";
  42 mkdir($aliases_prefix, 0755) unless -d $aliases_prefix;
  43
  44 #iscp("root\@$aliases","$aliases_prefix/aliases.import");
  45 iscp("ivan\@$aliases","$aliases_prefix/aliases.import");
  46
  47 print "\n\n", <<END;
  48 Enter the location and name of your Sendmail virtusertable directory, for example
  49 "mail.isp.com:/etc/mail/virtusertable"
  50 END
  51 my($virtusertable)=&getvalue(":");
  52
  53 use vars qw($virtusertable_machine $virtusertable_prefix);
  54 $virtusertable_machine = (split(/:/, $virtusertable))[0];
  55 $virtusertable_prefix = "$spooldir/$virtusertable_machine";
  56 mkdir($virtusertable_prefix, 0755) unless -d $virtusertable_prefix;
  57 mkdir("$virtusertable_prefix/virtusertable.import", 0755)
  58   unless -d "$virtusertable_prefix/virtusertable.import";
  59
  60 #iscp("root\@$virtusertable/*","$aliases_prefix/virtusertable.import/");
  61 iscp("ivan\@$virtusertable/*","$aliases_prefix/virtusertable.import/");
  62
  63 sub getvalue {
  64   my $prompt = shift;
  65   $^W=0; # Term::Query isn't -w-safe
  66   my $return = query $prompt, '';
  67   $^W=1;
  68   $return;
  69 }
  70
  71 print "\n\n";
  72
  73 ##
  74
  75 foreach my $file (
  76   "$aliases_prefix/aliases.import",
  77   glob("$aliases_prefix/virtusertable.import/*"),
  78 ) {
  79
  80   warn "importing $file\n";
  81
  82   open(FILE,"<$file") or die $!;
  83   while (<FILE>) {
  84     next if /^\s*#/ || /^\s*$/; #skip comments & blank lines
  85
  86     unless ( /^([\w\@\.\-]+)[:\s]\s*(.*\S)\s*$/ ) {
  87       warn "Unparsable line: $_";
  88       next;
  89     }
  90     my($rawusername, $rawdest) = ($1, $2);
  91
  92     my($username, $domain);
  93     if ( $rawusername =~ /^([\w\-\.\&]*)\@([\w\.\-]+)$/ ) {
  94       $username = $1;
  95       $domain = $2;
  96     } elsif ( $rawusername =~ /\@/ ) {
  97       die "Unparsable username: $rawusername\n";
  98     } else {
  99       $username = $rawusername;
 100       $domain = $defaultdomain;
 101     }
 102
 103     #find svc_acct record or set $src
 104     my($srcsvc, $src) = &svcnum_or_literal($username, $domain);
 105
 106     foreach my $dest ( split(/,/, $rawdest) ) {
 107
 108       my($dusername, $ddomain);
 109       if ( $dest =~ /^([\w\-\.\&]+)\@([\w\.\-]+)$/ ) {
 110         $dusername = $1;
 111         $ddomain = $2;
 112       } elsif ( $dest =~ /\@/ ) {
 113         die "Unparsable username: $dest\n";
 114       } else {
 115         $dusername = $dest;
 116         $ddomain = $defaultdomain;
 117       }
 118       my($dstsvc, $dst) = &svcnum_or_literal($dusername, $ddomain);
 119
 120       my $svc_forward = new FS::svc_forward ({
 121         svcpart => $forward_svcpart,
 122         srcsvc => $srcsvc,
 123         src    => $src,
 124         dstsvc => $dstsvc,
 125         dst    => $dst,
 126       });
 127       my $error = $svc_forward->insert;
 128       #my $error = $svc_forward->check;
 129       if ( $error ) {
 130         die "$rawusername: $rawdest: $error\n";
 131       }
 132     }
 133
 134
 135   } #next entry
 136
 137 } #next file
 138
 139 ##
 140
 141 sub svcnum_or_literal {
 142   my($username, $domain) = @_;
 143
 144   my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } );
 145   my $domsvc = $svc_domain ? $svc_domain->svcnum : '';
 146
 147   my @svc_acct = grep { my $svc_acct = $_;
 148                         grep { $svc_acct->cust_svc->svcpart == $_ } @svcpart
 149                       }
 150                    qsearch('svc_acct', {
 151                      'username' => $username,
 152                      'domsvc'   => $domsvc,
 153                    });
 154
 155   if ( scalar(@svc_acct) > 1 ) {
 156     die "multiple sources found for $username\@$domain !\n";
 157   }
 158
 159   my( $svcnum, $literal ) = ('', '');
 160   if ( @svc_acct ) {
 161     my $svc_acct = $svc_acct[0];
 162     $svcnum = $svc_acct->svcnum;
 163   } else {
 164     $literal = "$username\@$domain";
 165   }
 166
 167   return( $svcnum, $literal );
 168
 169 }
 170
 171 sub usage {
 172   die "Usage:\n\n  sendmail.import user\n";
 173 }
 174
 175
 176
 177
 178