bin/fs-migrate-svc_acct_sm

   1 #!/usr/bin/perl -Tw
   2 #
   3 # $Id: fs-migrate-svc_acct_sm,v 1.2 2001-08-12 19:41:25 jeff Exp $
   4 #
   5 # jeff@cmh.net 01-Jul-20
   6 #
   7 # $Log: fs-migrate-svc_acct_sm,v $
   8 # Revision 1.2  2001-08-12 19:41:25  jeff
   9 # merging vpopmail support branch
  10 #
  11 # Revision 1.1.2.1  2001/08/08 17:45:35  jeff
  12 # initial vpopmail support
  13 #
  14 #
  15 #
  16 #   Initial vpopmail changes
  17 #
  18
  19 #to delay loading dbdef until we're ready
  20 #BEGIN { $FS::Record::setup_hack = 1; }
  21
  22 use strict;
  23 use Term::Query qw(query);
  24 #use DBI;
  25 #use DBIx::DBSchema;
  26 #use DBIx::DBSchema::Table;
  27 #use DBIx::DBSchema::Column;
  28 #use DBIx::DBSchema::ColGroup::Unique;
  29 #use DBIx::DBSchema::ColGroup::Index;
  30 use FS::Conf;
  31 use FS::UID qw(adminsuidsetup datasrc checkeuid getsecrets);
  32 use FS::Record qw(qsearch qsearchs);
  33 use FS::svc_domain;
  34 use FS::svc_forward;
  35 use vars qw( $conf $old_default_domain %part_domain_svc %part_acct_svc %part_forward_svc $svc_acct $svc_acct_sm $error);
  36
  37 die "Not running uid freeside!" unless checkeuid();
  38
  39 my $user = shift or die &usage;
  40 getsecrets($user);
  41
  42 $conf = new FS::Conf;
  43 $old_default_domain = $conf->config('domain');
  44
  45 #needs to match FS::Record
  46 #my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc;
  47
  48 ###
  49 # This section would be the appropriate place to manipulate
  50 # the schema & tables.
  51 ###
  52
  53 ##  we need to add the domsvc to svc_acct
  54 ##  we must add a svc_forward record....
  55 ##  I am thinking that the fields  svcnum (int), destsvc (int), and
  56 ##  dest (varchar (80))  are appropriate, with destsvc/dest an either/or
  57 ##  much in the spirit of cust_main_invoice
  58
  59 ###
  60 # massage the data
  61 ###
  62
  63 my($dbh)=adminsuidsetup $user;
  64
  65 $|=1;
  66
  67 $FS::svc_acct::nossh_hack = 1;
  68 $FS::svc_forward::nossh_hack = 1;
  69 $FS::svc_domain::whois_hack = 1;
  70
  71 %part_domain_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_domain'});
  72 %part_acct_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
  73 %part_forward_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_forward'});
  74
  75 die "No services with svcdb svc_domain!\n" unless %part_domain_svc;
  76 die "No services with svcdb svc_acct!\n" unless %part_acct_svc;
  77 die "No services with svcdb svc_forward!\n" unless %part_forward_svc;
  78
  79 my($svc_domain) = qsearchs('svc_domain', { 'domain' => $old_default_domain });
  80 if (! $svc_domain || $svc_domain->domain != $old_default_domain) {
  81    print <<EOF;
  82
  83 Your database currently does not contain a svc_domain record for the
  84 domain $old_default_domain.  Would you like me to add one for you?
  85 EOF
  86
  87    my($response)=scalar(<STDIN>);
  88    chop $response;
  89    if ($response =~ /^[yY]/) {
  90       print "\n\n", &menu_domain_svc, "\n", <<END;
  91 I need to create new domain accounts.  Which service shall I use for that?
  92 END
  93       my($domain_svcpart)=&getdomainpart;
  94
  95       $svc_domain = new FS::svc_domain {
  96         'domain' => $old_default_domain,
  97         'svcpart' => $domain_svcpart,
  98         'action' => 'M',
  99        };
 100 #      $error=$svc_domain->insert && die "Error adding domain $old_default_domain: $error";
 101       $error=$svc_domain->insert;
 102       die "Error adding domain $old_default_domain: $error" if $error;
 103    }else{
 104       print <<EOF;
 105
 106   This program cannot function properly until a svc_domain record matching
 107 your conf_dir/domain file exists.
 108 EOF
 109
 110       exit 1;
 111    }
 112 }
 113
 114 print "\n\n", &menu_acct_svc, "\n", <<END;
 115 I may need to create some new pop accounts and set up forwarding to them
 116 for some users.  Which service shall I use for that?
 117 END
 118 my($pop_svcpart)=&getacctpart;
 119
 120 print "\n\n", &menu_forward_svc, "\n", <<END;
 121 I may need to create some new forwarding for some users.  Which service
 122 shall I use for that?
 123 END
 124 my($forward_svcpart)=&getforwardpart;
 125
 126 sub menu_domain_svc {
 127   ( join "\n", map "$_: ".$part_domain_svc{$_}->svc, sort keys %part_domain_svc ). "\n";
 128 }
 129 sub menu_acct_svc {
 130   ( join "\n", map "$_: ".$part_acct_svc{$_}->svc, sort keys %part_acct_svc ). "\n";
 131 }
 132 sub menu_forward_svc {
 133   ( join "\n", map "$_: ".$part_forward_svc{$_}->svc, sort keys %part_forward_svc ). "\n";
 134 }
 135 sub getdomainpart {
 136   $^W=0; # Term::Query isn't -w-safe
 137   my $return = query "Enter part number:", 'irk', [ keys %part_domain_svc ];
 138   $^W=1;
 139   $return;
 140 }
 141 sub getacctpart {
 142   $^W=0; # Term::Query isn't -w-safe
 143   my $return = query "Enter part number:", 'irk', [ keys %part_acct_svc ];
 144   $^W=1;
 145   $return;
 146 }
 147 sub getforwardpart {
 148   $^W=0; # Term::Query isn't -w-safe
 149   my $return = query "Enter part number:", 'irk', [ keys %part_forward_svc ];
 150   $^W=1;
 151   $return;
 152 }
 153
 154
 155 #migrate data
 156
 157 my(@svc_accts) = qsearch('svc_acct', {});
 158 foreach $svc_acct (@svc_accts) {
 159   my(@svc_acct_sms) = qsearch('svc_acct_sm', {
 160       domuid => $svc_acct->getfield('uid'),
 161       }
 162     );
 163
 164   #  Ok.. we've got the svc_acct record, and an array of svc_acct_sm's
 165   #  What do we do from here?
 166
 167   #  The intuitive:
 168   #    plop the svc_acct into the 'default domain'
 169   #    and then represent the svc_acct_sm's with svc_forwards
 170   #    they can be gussied up manually, later
 171   #
 172   #  Perhaps better:
 173   #    when no svc_acct_sm exists, place svc_acct in 'default domain'
 174   #    when one svc_acct_sm exists, place svc_acct in corresponding
 175   #      domain & possibly create a svc_forward in 'default domain'
 176   #    when multiple svc_acct_sm's exists (in different domains) we'd
 177   #    better use the 'intuitive' approach.
 178   #
 179   #  Specific way:
 180   #    as 'perhaps better,' but we may be able to guess which domain
 181   #    is correct by comparing the svcnum of domains to the username
 182   #    of the svc_acct
 183   #
 184
 185   # The intuitive way:
 186
 187   my $def_acct = new FS::svc_acct ( { $svc_acct->hash } );
 188   $def_acct->setfield('domsvc' => $svc_domain->getfield('svcnum'));
 189   $error = $def_acct->replace($svc_acct);
 190   die "Error replacing svc_acct for " . $def_acct->username . " : $error" if $error;
 191
 192   foreach $svc_acct_sm (@svc_acct_sms) {
 193
 194     my($domrec)=qsearchs('svc_domain', {
 195       svcnum => $svc_acct_sm->getfield('domsvc'),
 196     }) || die  "svc_acct_sm references invalid domsvc $svc_acct_sm->getfield('domsvc')\n";
 197
 198     if ($svc_acct_sm->getfield('domuser') =~ /^\*$/) {
 199
 200       my($newdom) = new FS::svc_domain ( { $domrec->hash } );
 201       $newdom->setfield('catchall', $svc_acct->svcnum);
 202       $newdom->setfield('action', "M");
 203       $error = $newdom->replace($domrec);
 204       die "Error replacing svc_domain for (anything)@" . $domrec->domain . " : $error" if $error;
 205
 206     } else {
 207
 208       my($newacct) = new FS::svc_acct {
 209         'svcpart'  => $pop_svcpart,
 210         'username' => $svc_acct_sm->getfield('domuser'),
 211         'domsvc'   => $svc_acct_sm->getfield('domsvc'),
 212         'dir'      => '/dev/null',
 213       };
 214       $error = $newacct->insert;
 215       die "Error adding svc_acct for " . $newacct->username . " : $error" if $error;
 216
 217       my($newforward) = new FS::svc_forward {
 218         'svcpart'  => $forward_svcpart,
 219         'srcsvc'   => $newacct->getfield('svcnum'),
 220         'dstsvc'   => $def_acct->getfield('svcnum'),
 221       };
 222       $error = $newforward->insert;
 223       die "Error adding svc_forward for " . $newacct->username ." : $error" if $error;
 224     }
 225
 226     $error = $svc_acct_sm->delete;
 227     die "Error deleting svc_acct_sm for " . $svc_acct_sm->domuser ." : $error" if $error;
 228
 229   };
 230
 231 };
 232
 233
 234 $dbh->commit or die $dbh->errstr;
 235 $dbh->disconnect or die $dbh->errstr;
 236
 237 print "svc_acct_sm records sucessfully migrated\n";
 238
 239 sub usage {
 240   die "Usage:\n  fs-migrate-svc_acct_sm user\n";
 241 }
 242