#!/usr/bin/perl -Tw # # $Id: svc_acct_sm.import,v 1.5 2000-02-03 05:16:52 ivan Exp $ # # ivan@sisd.com 98-mar-9 # # generalized svcparts ivan@sisd.com 98-mar-23 # You really need to enable ssh into a shell machine as this needs to rename # .qmail-extension files. # # now an interactive script ivan@sisd.com 98-jun-30 # # has an (untested) section for sendmail, s/warn/die/g and generates a program # to run on your mail machine _later_ instead of ssh'ing for each user # ivan@sisd.com 98-jul-13 # # $Log: svc_acct_sm.import,v $ # Revision 1.5 2000-02-03 05:16:52 ivan # beginning of DNS and Apache support # # Revision 1.4 1999/03/25 08:42:20 ivan # import stuff uses Term::Query and spits out (some kinds of) nonsensical input # # Revision 1.3 1999/03/24 00:51:55 ivan # die if no relevant services... cvspain # # Revision 1.2 1998/12/10 07:23:18 ivan # use FS::Conf, need user (for datasrc) # use strict; use vars qw(%d_part_svc %m_part_svc); use Term::Query qw(query); use FS::SSH qw(iscp); use FS::UID qw(adminsuidsetup datasrc); use FS::Record qw(qsearch qsearchs); use FS::svc_acct_sm; use FS::svc_domain; use FS::svc_acct; use FS::part_svc; my $user = shift or die &usage; adminsuidsetup $user; my($spooldir)="/usr/local/etc/freeside/export.". datasrc; my(%mta) = ( 1 => "qmail", 2 => "sendmail", ); ### %d_part_svc = map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_domain'}); %m_part_svc = map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct_sm'}); die "No services with svcdb svc_domain!\n" unless %d_part_svc; die "No services with svcdb svc_svc_acct_sm!\n" unless %m_part_svc; print "\n\n", ( join "\n", map "$_: ".$d_part_svc{$_}->svc, sort keys %d_part_svc ), "\n\n"; $^W=0; #Term::Query isn't -w-safe my $domain_svcpart = query "Enter part number for domains: ", 'irk', [ keys %d_part_svc ]; $^W=1; print "\n\n", ( join "\n", map "$_: ".$m_part_svc{$_}->svc, sort keys %m_part_svc ), "\n\n"; $^W=0; #Term::Query isn't -w-safe my $mailalias_svcpart = query "Enter part number for mail aliases: ", 'irk', [ keys %m_part_svc ]; $^W=1; print "\n\n", <) { next if /^(#|$)/; /^\.?([\w\-\.]+)$/ #or do { warn "Strange rcpthosts/sendmail.cw line: $_"; next; }; or die "Strange rcpthosts/sendmail.cw line: $_"; my $domain = $1; my($svc_domain); unless ( $svc_domain = qsearchs('svc_domain', {'domain'=>$domain} ) ) { $svc_domain = new FS::svc_domain ({ 'domain' => $domain, 'svcpart' => $domain_svcpart, 'action' => 'N', }); my $error = $svc_domain->insert; #warn $error if $error; die $error if $error; } $svcnum{$domain}=$svc_domain->svcnum; } close RCPTHOSTS; #these two loops have enough similar parts they should probably be merged if ( $mta{$mta} eq "qmail" ) { open(VD_FIX,">$spooldir/virtualdomains.FIX"); print VD_FIX "#!/usr/bin/perl\n"; open(VIRTUALDOMAINS,"<$spooldir/virtualdomains.import") or die "Can't open $spooldir/virtualdomains.import: $!"; while () { next if /^#/; /^\.?([\w\-\.]+):(\w+)(\-([\w\-\.]+))?$/ #or do { warn "Strange virtualdomains line: $_"; next; }; or die "Strange virtualdomains line: $_"; my($domain,$username,$dash_ext,$extension)=($1,$2,$3,$4); $dash_ext ||= ''; $extension ||= ''; my($svc_acct)=qsearchs('svc_acct',{'username'=>$username}); unless ( $svc_acct ) { #warn "Unknown user $username in virtualdomains; skipping\n"; #die "Unknown user $username in virtualdomains; skipping\n"; next; } if ( $domain ne $extension ) { #warn "virtualdomains line $domain:$username$dash_ext changed to $domain:$username-$domain\n"; my($dir)=$svc_acct->dir; my($qdomain)=$domain; $qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES #example to move .qmail files for virtual domains to their new location #dry run #issh("root\@$shellmachine",'perl -e \'foreach $a (<'. $dir. '/.qmail'. $dash_ext. '-*>) { $old=$a; $a =~ s/\\.qmail'. $dash_ext. '\\-/\\.qmail\\-'. $qdomain. '\\-/; print " $old -> $a\n"; }\''); #the real thing #issh("root\@$shellmachine",'perl -e \'foreach $a (<'. $dir. '/.qmail'. $dash_ext. '-*>) { $old=$a; $a =~ s/\\.qmail'. $dash_ext. '\\-/\\.qmail\\-'. $qdomain. '\\-/; rename $old, $a; }\''); print VD_FIX <) { \$old = \$file; \$file =~ s/\.qmail$dash_ext\-/\.qmail\-$qdomain\-/; rename \$old, \$file; } END } unless ( exists $svcnum{$domain} ) { my($svc_domain) = new FS::svc_domain ({ 'domain' => $domain, 'svcpart' => $domain_svcpart, 'action' => 'N', }); my $error = $svc_domain->insert; #warn $error if $error; die $error if $error; $svcnum{$domain}=$svc_domain->svcnum; } my($svc_acct_sm)=new FS::svc_acct_sm ({ 'domsvc' => $svcnum{$domain}, 'domuid' => $svc_acct->uid, 'domuser' => '*', 'svcpart' => $mailalias_svcpart, }); my($error)=''; $error=$svc_acct_sm->insert; #warn $error if $error; die $error, ", domain $domain" if $error; } close VIRTUALDOMAINS; close VD_FIX; } elsif ( $mta{$mta} eq "sendmail" ) { open(VIRTUSERTABLE,"<$spooldir/virtusertable.import") or die "Can't open $spooldir/virtusertable.import: $!"; while () { next if /^#/; #comments? /^([\w\-\.]+)?\@([\w\-\.]+)\t([\w\-\.]+)$/ #or do { warn "Strange virtusertable line: $_"; next; }; or die "Strange virtusertable line: $_"; my($domuser,$domain,$username)=($1,$2,$3); my($svc_acct)=qsearchs('svc_acct',{'username'=>$username}); unless ( $svc_acct ) { #warn "Unknown user $username in virtusertable"; die "Unknown user $username in virtusertable"; next; } my($svc_acct_sm)=new FS::svc_acct_sm ({ 'domsvc' => $svcnum{$domain}, 'domuid' => $svc_acct->uid, 'domuser' => $domuser || '*', 'svcpart' => $mailalias_svcpart, }); my($error)=''; $error=$svc_acct_sm->insert; #warn $error if $error; die $error if $error; } close VIRTUSERTABLE; } else { die "Unknown MTA!\n"; } #open(RECIPIENTMAP,"<$spooldir/recipientmap.import"); #close RECIPIENTMAP; print "\n\n", <