summaryrefslogtreecommitdiff
path: root/bin
diff options
context:
space:
mode:
Diffstat (limited to 'bin')
-rwxr-xr-xbin/apache.export65
-rwxr-xr-xbin/bind.export190
-rwxr-xr-xbin/bind.import192
-rwxr-xr-xbin/bsdshell.export114
-rw-r--r--bin/create-fetchmailrc45
-rwxr-xr-xbin/create-history-tables93
-rwxr-xr-xbin/dbdef-create24
-rwxr-xr-xbin/fix-sequences69
-rwxr-xr-xbin/freeside-init60
-rwxr-xr-xbin/freeside-session-kill103
-rwxr-xr-xbin/fs-migrate-part_svc41
-rwxr-xr-xbin/fs-migrate-payref31
-rwxr-xr-xbin/fs-migrate-svc_acct_sm229
-rwxr-xr-xbin/fs-radius-add-check68
-rwxr-xr-xbin/fs-radius-add-reply69
-rwxr-xr-xbin/generate-prepay35
-rwxr-xr-xbin/generate-raddb47
-rwxr-xr-xbin/generate-tests21
-rwxr-xr-xbin/masonize72
-rwxr-xr-xbin/passwd.import120
-rwxr-xr-xbin/pod2x56
-rwxr-xr-xbin/populate-msgcat127
-rwxr-xr-xbin/postfix.export121
-rw-r--r--bin/sendmail.import176
-rwxr-xr-xbin/shadow.reimport98
-rwxr-xr-xbin/svc_acct.export641
-rwxr-xr-xbin/svc_acct.import238
-rwxr-xr-xbin/svc_domain.erase17
-rwxr-xr-xbin/sysvshell.export112
29 files changed, 3274 insertions, 0 deletions
diff --git a/bin/apache.export b/bin/apache.export
new file mode 100755
index 0000000..f0a6bee
--- /dev/null
+++ b/bin/apache.export
@@ -0,0 +1,65 @@
+#!/usr/bin/perl -w
+
+use strict;
+#use File::Path;
+use File::Rsync;
+use Net::SSH qw(ssh);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch qsearchs);
+use FS::part_export;
+use FS::cust_svc;
+use FS::svc_www;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+#needs the export number in there somewhere too...?
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/apache";
+mkdir $spooldir, 0700 unless -d $spooldir;
+
+my @exports = qsearch('part_export', { 'exporttype' => 'apache' } );
+
+my $rsync = File::Rsync->new({
+ rsh => 'ssh',
+# dry_run => 1,
+});
+
+foreach my $export ( @exports ) {
+
+ my $machine = $export->machine;
+ my $file = "$spooldir/$machine.conf";
+
+ open(HTTPD_CONF,">$file") or die "can't open $file: $!";
+
+ my $template = $export->option('template');
+
+ my @svc_www = $export->svc_x;
+
+ foreach my $svc_www ( @svc_www ) {
+ use vars qw($zone $username);
+ $zone = $svc_www->domain_record->zone;
+ $username = $svc_www->svc_acct->username;
+ print HTTPD_CONF eval(qq("$template")). "\n\n";
+ }
+
+ my $user = $export->option('user');
+ my $httpd_conf = $export->option('httpd_conf');
+
+ $rsync->exec( {
+ src => $file,
+ dest => "$user\@$machine:$httpd_conf",
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+ # warn $rsync->out;
+
+ ssh("root\@$machine", 'apachectl graceful');
+
+}
+
+close HTTPD_CONF;
+
+# -----
+
+sub usage {
+ die "Usage:\n apache.export user\n";
+}
+
diff --git a/bin/bind.export b/bin/bind.export
new file mode 100755
index 0000000..64d4406
--- /dev/null
+++ b/bin/bind.export
@@ -0,0 +1,190 @@
+#!/usr/bin/perl -w
+
+use strict;
+use File::Path;
+use File::Rsync;
+use Net::SSH qw(ssh);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch qsearchs);
+use FS::part_export;
+use FS::cust_pkg;
+use FS::cust_svc;
+use FS::svc_domain;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/bind";
+mkdir $spooldir, 0700 unless -d $spooldir;
+
+my @exports = qsearch('part_export', { 'exporttype' => 'bind' } );
+my @sexports = qsearch('part_export', { 'exporttype' => 'bind_slave' } );
+
+my $rsync = File::Rsync->new({
+ rsh => 'ssh',
+# dry_run => 1,
+});
+
+foreach my $export ( @exports ) {
+
+ my $machine = $export->machine;
+ my $prefix = "$spooldir/$machine";
+
+ my $bind_rel = $export->option('bind_release');
+ my $ndc_cmd = ($bind_rel eq 'BIND9') ? 'rndc' : 'ndc';
+ my $minttl = $export->option('bind9_minttl');
+
+ #prevent old domain files from piling up
+ #rmtree "$prefix" or die "can't rmtree $prefix.db: $!";
+
+ mkdir $prefix, 0700 unless -d $prefix;
+
+ open(NAMED_CONF,">$prefix/named.conf")
+ or die "can't open $prefix/named.conf: $!";
+
+ open(CONF_HEADER,"<$prefix/named.conf.HEADER")
+ or die "can't open $prefix/named.conf.HEADER: $!";
+ while (<CONF_HEADER>) { print NAMED_CONF $_; }
+ close CONF_HEADER;
+
+ my $zonepath = $export->option('zonepath');
+ $zonepath =~ s/\/$//;
+
+ my @svc_domain = $export->svc_x;
+
+ foreach my $svc_domain ( @svc_domain ) {
+ my $domain = $svc_domain->domain;
+ my @masters = qsearch('domain_record', {
+ 'svcnum' => $svc_domain->svcnum,
+ 'rectype' => '_mstr',
+ } );
+ if ( @masters ) {
+ my $masters = join('; ', map { $_->recdata } @masters );
+
+ print NAMED_CONF <<END;
+zone "$domain" {
+ type slave;
+ file "db.$domain";
+ masters { $masters; };
+};
+
+END
+
+ } else {
+
+ print NAMED_CONF <<END;
+zone "$domain" {
+ type master;
+ file "$zonepath/db.$domain";
+};
+
+END
+
+ open (DB_MASTER,">$prefix/db.$domain")
+ or die "can't open $prefix/db.$domain: $!";
+
+ if ($bind_rel eq 'BIND9') {
+ print DB_MASTER "\$TTL $minttl\n\$ORIGIN $domain.\n";
+ }
+
+ my @domain_records =
+ qsearch('domain_record', { 'svcnum' => $svc_domain->svcnum } );
+ foreach my $domain_record (
+ sort { $b->rectype cmp $a->rectype } @domain_records
+ ) {
+ #if ( $domain_record->rectype eq 'SOA' ) {
+ # print DB_MASTER join("\t", $domain_record-> reczone
+ #} else {
+ print DB_MASTER join("\t",
+ map { $domain_record->getfield($_) }
+ qw( reczone recaf rectype recdata )
+ ), "\n";
+ #}
+ }
+
+ close DB_MASTER;
+
+ }
+
+ }
+
+ $rsync->exec( {
+ src => "$prefix/",
+ recursive => 1,
+ dest => "root\@$machine:$zonepath/",
+ exclude => [qw( *.import named.conf.HEADER named.conf )],
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+ # warn $rsync->out;
+
+ $rsync->exec( {
+ src => "$prefix/named.conf",
+ dest => "root\@$machine:". $export->option('named_conf'),
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+# warn $rsync->out;
+
+ ssh("root\@$machine", "$ndc_cmd reload");
+
+}
+
+close NAMED_CONF;
+
+foreach my $sexport ( @sexports ) { #false laziness with above
+
+ my $machine = $sexport->machine;
+ my $prefix = "$spooldir/$machine";
+
+ my $bind_rel = $sexport->option('bind_release');
+ my $ndc_cmd = ($bind_rel eq 'BIND9') ? 'rndc' : 'ndc';
+
+ #prevent old domain files from piling up
+ #rmtree "$prefix" or die "can't rmtree $prefix.db: $!";
+
+ mkdir $prefix, 0700 unless -d $prefix;
+
+ open(NAMED_CONF,">$prefix/named.conf")
+ or die "can't open $prefix/named.conf: $!";
+
+ open(CONF_HEADER,"<$prefix/named.conf.HEADER")
+ or die "can't open $prefix/named.conf.HEADER: $!";
+ while (<CONF_HEADER>) { print NAMED_CONF $_; }
+ close CONF_HEADER;
+
+ my $masters = $sexport->option('master');
+
+ #false laziness with freeside-sqlradius-reset
+ my @svc_domain =
+ map { qsearchs('svc_domain', { 'svcnum' => $_->svcnum } ) }
+ map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ $sexport->export_svc;
+
+ foreach my $svc_domain ( @svc_domain ) {
+ my $domain = $svc_domain->domain;
+ print NAMED_CONF <<END;
+zone "$domain" {
+ type slave;
+ file "db.$domain";
+ masters { $masters; };
+};
+
+END
+
+ }
+
+ $rsync->exec( {
+ src => "$prefix/named.conf",
+ dest => "root\@$machine:". $sexport->option('named_conf'),
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+# warn $rsync->out;
+
+ ssh("root\@$machine", "$ndc_cmd reload");
+
+}
+close NAMED_CONF;
+
+# -----
+
+sub usage {
+ die "Usage:\n bind.export user\n";
+}
+
diff --git a/bin/bind.import b/bin/bind.import
new file mode 100755
index 0000000..3287b01
--- /dev/null
+++ b/bin/bind.import
@@ -0,0 +1,192 @@
+#!/usr/bin/perl -w
+#
+# $Id: bind.import,v 1.4 2004-02-12 10:44:11 ivan Exp $
+
+#need to manually put header in /usr/local/etc/freeside/export.<datasrc./bind/<machine>/named.conf.HEADER
+
+use strict;
+use vars qw( %d_part_svc );
+use Term::Query qw(query);
+#use BIND::Conf_Parser;
+#use DNS::ZoneParse 0.81;
+
+#use Net::SCP qw(iscp);
+use Net::SCP qw(scp);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch); #qsearchs);
+#use FS::svc_acct_sm;
+use FS::svc_domain;
+use FS::domain_record;
+#use FS::svc_acct;
+#use FS::part_svc;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+$FS::svc_Common::noexport_hack = 1;
+$FS::domain_record::noserial_hack = 1;
+
+use vars qw($spooldir);
+$spooldir = "/usr/local/etc/freeside/export.". datasrc. "/bind";
+mkdir $spooldir unless -d $spooldir;
+
+%d_part_svc =
+ map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_domain'});
+
+print "\n\n",
+ ( join "\n", map "$_: ".$d_part_svc{$_}->svc, sort keys %d_part_svc ),
+ "\n\n";
+use vars qw($domain_svcpart);
+$^W=0; #Term::Query isn't -w-safe
+$domain_svcpart =
+ query "Enter part number for domains: ", 'irk', [ keys %d_part_svc ];
+$^W=1;
+
+print "\n\n", <<END;
+Enter the location and name of your primary named.conf file, for example
+"ns.isp.com:/var/named/named.conf"
+END
+my($named_conf)=&getvalue(":");
+
+use vars qw($named_machine $prefix);
+$named_machine = (split(/:/, $named_conf))[0];
+$prefix = "$spooldir/$named_machine";
+mkdir $prefix unless -d $prefix;
+
+#iscp("root\@$named_conf","$prefix/named.conf.import");
+scp("root\@$named_conf","$prefix/named.conf.import");
+
+
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
+}
+
+print "\n\n";
+
+##
+
+$FS::svc_domain::whois_hack=1;
+
+my $p = Parser->new;
+$p->parse_file("$prefix/named.conf.import");
+
+print "\nBIND import completed.\n";
+
+##
+
+sub usage {
+ die "Usage:\n\n bind.import user\n";
+}
+
+########
+BEGIN {
+
+ package Parser;
+ use BIND::Conf_Parser;
+ use vars qw(@ISA $named_dir);
+ @ISA = qw(BIND::Conf_Parser);
+
+ sub handle_option {
+ my($self, $option, $argument) = @_;
+ return unless $option eq "directory";
+ $named_dir = $argument;
+ }
+
+ sub handle_zone {
+ my($self, $name, $class, $type, $options) = @_;
+ return unless $class eq 'in';
+ return if grep { $name eq $_ }
+ ( qw( . localhost 127.in-addr.arpa 0.in-addr.arpa 255.in-addr.arpa ) );
+
+ my $domain = new FS::svc_domain( {
+ svcpart => $main::domain_svcpart,
+ domain => $name,
+ action => 'N',
+ } );
+ my $error = $domain->insert;
+ die $error if $error;
+
+ if ( $type eq 'slave' ) {
+
+ #use Data::Dumper;
+ #print Dumper($options);
+ #exit;
+
+ foreach my $master ( @{ $options->{masters} } ) {
+ my $domain_record = new FS::domain_record( {
+ 'svcnum' => $domain->svcnum,
+ 'reczone' => '@',
+ 'recaf' => 'IN',
+ 'rectype' => '_mstr',
+ 'recdata' => $master,
+ } );
+ my $error = $domain_record->insert;
+ die $error if $error;
+ }
+
+ } elsif ( $type eq 'master' ) {
+
+ my $file = $options->{file};
+
+ use File::Basename;
+ my $basefile = basename($file);
+ my $sourcefile = $file;
+ $sourcefile = "$named_dir/$sourcefile" unless $file =~ /^\//;
+ use Net::SCP qw(iscp scp);
+ scp("root\@$main::named_machine:$sourcefile",
+ "$main::prefix/$basefile.import");
+
+ use DNS::ZoneParse 0.81;
+ my $zone = DNS::ZoneParse->new("$main::prefix/$basefile.import");
+
+ my $dump = $zone->Dump;
+
+ #use Data::Dumper;
+ #print "$name: ". Dumper($dump);
+ #exit;
+
+ foreach my $rectype ( keys %$dump ) {
+ if ( $rectype =~ /^SOA$/i ) {
+ my $rec = $dump->{$rectype};
+ my $domain_record = new FS::domain_record( {
+ 'svcnum' => $domain->svcnum,
+ 'reczone' => $rec->{origin},
+ 'recaf' => 'IN',
+ 'rectype' => $rectype,
+ 'recdata' =>
+ $rec->{primary}. ' '. $rec->{email}. ' ( '.
+ join(' ', map $rec->{$_},
+ qw( serial refresh retry expire minimumTTL ) ).
+ ' )',
+ } );
+ my $error = $domain_record->insert;
+ die $error if $error;
+ } else {
+ #die $dump->{$rectype};
+ foreach my $rec ( @{ $dump->{$rectype} } ) {
+ my $domain_record = new FS::domain_record( {
+ 'svcnum' => $domain->svcnum,
+ 'reczone' => $rec->{name},
+ 'recaf' => $rec->{class},
+ 'rectype' => $rectype,
+ 'recdata' => ( $rectype =~ /^MX$/i
+ ? $rec->{priority}. ' '. $rec->{host}
+ : $rec->{host} ),
+ } );
+ my $error = $domain_record->insert;
+ die $error if $error;
+ }
+ }
+ }
+
+ }
+
+ }
+
+}
+#########
+
diff --git a/bin/bsdshell.export b/bin/bsdshell.export
new file mode 100755
index 0000000..6e0d103
--- /dev/null
+++ b/bin/bsdshell.export
@@ -0,0 +1,114 @@
+#!/usr/bin/perl -w
+
+# bsdshell export
+
+use strict;
+use File::Rsync;
+use Net::SSH qw(ssh);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch qsearchs);
+use FS::part_export;
+use FS::cust_svc;
+use FS::svc_acct;
+
+my @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc;
+#my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/shell";
+
+my @bsd_exports = qsearch('part_export', { 'exporttype' => 'bsdshell' } );
+
+my $rsync = File::Rsync->new({
+ rsh => 'ssh',
+# dry_run => 1,
+});
+
+foreach my $export ( @bsd_exports ) {
+ my $machine = $export->machine;
+ my $prefix = "$spooldir/$machine";
+ mkdir $prefix, 0700 unless -d $prefix;
+
+ #LOCKING!!!
+
+ ( open(MASTER,">$prefix/master.passwd")
+ #!!! and flock(MASTER,LOCK_EX|LOCK_NB)
+ ) or die "Can't open $prefix/master.passwd: $!";
+ ( open(PASSWD,">$prefix/passwd")
+ #!!! and flock(PASSWD,LOCK_EX|LOCK_NB)
+ ) or die "Can't open $prefix/passwd: $!";
+
+ chmod 0644, "$prefix/passwd";
+ chmod 0600, "$prefix/master.passwd";
+
+ my @svc_acct = $export->svc_x;
+
+ next unless @svc_acct;
+
+ foreach my $svc_acct ( sort { $a->uid <=> $b->uid } @svc_acct ) {
+
+ my $password = $svc_acct->_password;
+ my $cpassword;
+ #if ( ( length($password) <= 8 )
+ if ( ( length($password) <= 12 )
+ && ( $password ne '*' )
+ && ( $password ne '!!' )
+ && ( $password ne '' )
+ ) {
+ $cpassword=crypt($password,
+ $saltset[int(rand(64))].$saltset[int(rand(64))]
+ );
+ # MD5 !!!!
+ } else {
+ $cpassword=$password;
+ }
+
+ ###
+ # FORMAT OF THE PASSWD FILE HERE
+ print PASSWD join(":",
+ $svc_acct->username,
+ 'x', # "##". $username,
+ $svc_acct->uid,
+ $svc_acct->gid,
+ $svc_acct->finger,
+ $svc_acct->dir,
+ $svc_acct->shell,
+ ), "\n";
+
+ ###
+ # FORMAT OF FreeBSD MASTER PASSWD FILE HERE
+ print MASTER join(":",
+ $svc_acct->username, # User name
+ $cpassword, # Encrypted password
+ $svc_acct->uid, # User ID
+ $svc_acct->gid, # Group ID
+ "", # Login Class
+ "0", # Password Change Time
+ "0", # Password Expiration Time
+ $svc_acct->finger, # Users name
+ $svc_acct->dir, # Users home directory
+ $svc_acct->shell, # shell
+ ), "\n" ;
+
+ }
+
+ #!!! flock(MASTER,LOCK_UN);
+ #!!! flock(PASSWD,LOCK_UN);
+ close MASTER;
+ close PASSWD;
+
+ $rsync->exec( {
+ src => "$prefix/passwd",
+ dest => "root\@$machine:/etc/passwd"
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+
+ $rsync->exec( {
+ src => "$prefix/master.passwd",
+ dest => "root\@$machine:/etc/master.passwd.new"
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+ ssh("root\@$machine", "pwd_mkdb /etc/master.passwd.new");
+
+ # UNLOCK!!
+}
diff --git a/bin/create-fetchmailrc b/bin/create-fetchmailrc
new file mode 100644
index 0000000..e929711
--- /dev/null
+++ b/bin/create-fetchmailrc
@@ -0,0 +1,45 @@
+#!/usr/bin/perl -w
+# this quick hack helps you generate/maintain .fetchmailrc files from
+# FS::acct_snarf data. it is run from a shellcommands export as:
+# create-fetchmailrc $username $dir $snarf_machine1 $snarf_username1 $snarf__password1 $snarf_machine2 $snarf_username2 $snarf__password2 ...
+
+use strict;
+use POSIX qw( setuid setgid );
+
+my $header = <<END;
+# Configuration created by create-fetchmailrc
+set postmaster "postmaster"
+set bouncemail
+set no spambounce
+set properties ""
+set daemon 240
+END
+
+my $username = shift @ARGV or die "no username specified\n";
+my $homedir = shift @ARGV or die "no homedir specified\n";
+my $filename = "$homedir/.fetchmailrc";
+
+my $gid = scalar(getgrnam($username)) or die "can't find $username's gid\n";
+my $uid = scalar(getpwnam($username)) or die "can't find $username's uid\n";
+
+open(FETCHMAILRC, ">$filename") or die "can't open $filename: $!\n";
+chown $uid, $gid, $filename or die "can't chown $uid.$gid $filename: $!\n";
+chmod 0600, $filename or die "can't chmod 600 $filename: $!\n";
+print FETCHMAILRC $header;
+
+while ($ARGV[0]) {
+ my( $s_machine, $s_username, $s_password ) = splice( @ARGV, 0, 3 );
+ print FETCHMAILRC <<END;
+poll $s_machine
+ user '$s_username' there with password '$s_password' is '$username' here
+END
+}
+
+close FETCHMAILRC;
+
+setgid($gid) or die "can't setgid $gid\n";
+setuid($uid) or die "can't setuid $uid\n";
+$ENV{HOME} = $homedir;
+
+system(qq(fetchmail -a -K --antispam "550,451" -d 180 -f $filename));
+
diff --git a/bin/create-history-tables b/bin/create-history-tables
new file mode 100755
index 0000000..39248bf
--- /dev/null
+++ b/bin/create-history-tables
@@ -0,0 +1,93 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use DBI;
+use DBIx::DBSchema 0.21;
+use DBIx::DBSchema::Table;
+use DBIx::DBSchema::Column;
+use DBIx::DBSchema::ColGroup::Unique;
+use DBIx::DBSchema::ColGroup::Index;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(dbdef);
+
+my $user = shift or die &usage;
+my $dbh = adminsuidsetup $user;
+
+my $schema = dbdef();
+
+#false laziness w/fs-setup
+my @tables = scalar(@ARGV)
+ ? @ARGV
+ : grep { ! /^(h|pg)_/ } $schema->tables;
+foreach my $table ( @tables ) {
+ next if grep { /^h_$table/ } $schema->tables;
+ warn "creating history table for $table\n";
+ my $tableobj = $schema->table($table)
+ or die "unknown table $table (did you run dbdef-create?)\n";
+ my $h_tableobj = DBIx::DBSchema::Table->new( {
+ name => "h_$table",
+ primary_key => 'historynum',
+ unique => DBIx::DBSchema::ColGroup::Unique->new( [] ),
+ 'index' => DBIx::DBSchema::ColGroup::Index->new( [
+ @{$tableobj->unique->lol_ref},
+ @{$tableobj->index->lol_ref}
+ ] ),
+ columns => [
+ DBIx::DBSchema::Column->new( {
+ 'name' => 'historynum',
+ 'type' => 'serial',
+ 'null' => 'NOT NULL',
+ 'length' => '',
+ 'default' => '',
+ 'local' => '',
+ } ),
+ DBIx::DBSchema::Column->new( {
+ 'name' => 'history_date',
+ 'type' => 'int',
+ 'null' => 'NULL',
+ 'length' => '',
+ 'default' => '',
+ 'local' => '',
+ } ),
+ DBIx::DBSchema::Column->new( {
+ 'name' => 'history_user',
+ 'type' => 'varchar',
+ 'null' => 'NOT NULL',
+ 'length' => '80',
+ 'default' => '',
+ 'local' => '',
+ } ),
+ DBIx::DBSchema::Column->new( {
+ 'name' => 'history_action',
+ 'type' => 'varchar',
+ 'null' => 'NOT NULL',
+ 'length' => '80',
+ 'default' => '',
+ 'local' => '',
+ } ),
+ map {
+ my $column = $tableobj->column($_);
+ $column->type('int')
+ if $column->type eq 'serial';
+ $column->default('')
+ if $column->default =~ /^nextval\(/i;
+ ( my $local = $column->local ) =~ s/AUTO_INCREMENT//i;
+ $column->local($local);
+ $column;
+ } $tableobj->columns
+ ],
+ } );
+ foreach my $statement ( $h_tableobj->sql_create_table($dbh) ) {
+ $dbh->do( $statement )
+ or die "CREATE error: ". $dbh->errstr. "\ndoing statement: $statement";
+ }
+
+}
+
+$dbh->commit or die $dbh->errstr;
+$dbh->disconnect or die $dbh->errstr;
+
+sub usage {
+ die "Usage:\n create-history-tables user [ table table ... ] \n";
+}
+
diff --git a/bin/dbdef-create b/bin/dbdef-create
new file mode 100755
index 0000000..a449d67
--- /dev/null
+++ b/bin/dbdef-create
@@ -0,0 +1,24 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use DBI;
+use DBIx::DBSchema 0.22;
+use FS::UID qw(adminsuidsetup datasrc driver_name);
+
+my $user = shift or die &usage;
+
+my($dbh)=adminsuidsetup $user;
+
+#needs to match FS::Record
+my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc;
+
+my $dbdef = new_native DBIx::DBSchema $dbh;
+
+#print $dbdef->pretty_print;
+
+#important
+$dbdef->save($dbdef_file);
+
+sub usage {
+ die "Usage:\n dbdef-create user\n";
+}
diff --git a/bin/fix-sequences b/bin/fix-sequences
new file mode 100755
index 0000000..2ff89d3
--- /dev/null
+++ b/bin/fix-sequences
@@ -0,0 +1,69 @@
+#!/usr/bin/perl -Tw
+
+# run dbdef-create first!
+
+use strict;
+use DBI;
+use DBIx::DBSchema 0.21;
+use DBIx::DBSchema::Table;
+use DBIx::DBSchema::Column;
+use DBIx::DBSchema::ColGroup::Unique;
+use DBIx::DBSchema::ColGroup::Index;
+use FS::UID qw(adminsuidsetup driver_name);
+use FS::Record qw(dbdef);
+
+my $user = shift or die &usage;
+my $dbh = adminsuidsetup $user;
+
+my $schema = dbdef();
+
+#false laziness w/fs-setup
+my @tables = scalar(@ARGV)
+ ? @ARGV
+ : grep { ! /^h_/ } $schema->tables;
+foreach my $table ( @tables ) {
+ my $tableobj = $schema->table($table)
+ or die "unknown table $table (did you run dbdef-create?)\n";
+
+ my $primary_key = $tableobj->primary_key;
+ next unless $primary_key;
+
+ my $col = $tableobj->column($primary_key);
+
+
+ next unless uc($col->type) eq 'SERIAL'
+ || ( driver_name eq 'Pg'
+ && defined($col->default)
+ && $col->default =~ /^nextval\(/i
+ )
+ || ( driver_name eq 'mysql'
+ && defined($col->local)
+ && $col->local =~ /AUTO_INCREMENT/i
+ );
+
+ my $seq = "${table}_${primary_key}_seq";
+ if ( driver_name eq 'Pg'
+ && defined($col->default)
+ && $col->default =~ /^nextval\('"(public\.)?(\w+_seq)"'::text\)$/
+ ) {
+ $seq = $2;
+ }
+
+ warn "fixing sequence for $table\n";
+
+
+ my $sql = "SELECT setval( '$seq',
+ ( SELECT max($primary_key) FROM $table ) );";
+
+ #warn $col->default. " $seq\n$sql\n";
+ $dbh->do( $sql ) or die $dbh->errstr;
+
+}
+
+$dbh->commit or die $dbh->errstr;
+$dbh->disconnect or die $dbh->errstr;
+
+sub usage {
+ die "Usage:\n fix-sequences user [ table table ... ] \n";
+}
+
diff --git a/bin/freeside-init b/bin/freeside-init
new file mode 100755
index 0000000..fe12931
--- /dev/null
+++ b/bin/freeside-init
@@ -0,0 +1,60 @@
+#! /bin/sh
+#
+# start the freeside job queue daemon
+
+#PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin
+DAEMON=/usr/local/bin/freeside-queued
+NAME=freeside-queued
+DESC="freeside job queue daemon"
+USER="ivan"
+
+test -f $DAEMON || exit 0
+
+set -e
+
+case "$1" in
+ start)
+ echo -n "Starting $DESC: "
+# start-stop-daemon --start --quiet --pidfile /var/run/$NAME.pid -b -m\
+# --exec $DAEMON
+ $DAEMON $USER &
+ echo "$NAME."
+ ;;
+ stop)
+ echo -n "Stopping $DESC: "
+ start-stop-daemon --stop --quiet --pidfile /var/run/$NAME.pid \
+ --exec $DAEMON
+ echo "$NAME."
+ rm /var/run/$NAME.pid
+ ;;
+ #reload)
+ #
+ # If the daemon can reload its config files on the fly
+ # for example by sending it SIGHUP, do it here.
+ #
+ # If the daemon responds to changes in its config file
+ # directly anyway, make this a do-nothing entry.
+ #
+ # echo "Reloading $DESC configuration files."
+ # start-stop-daemon --stop --signal 1 --quiet --pidfile \
+ # /var/run/$NAME.pid --exec $DAEMON
+ #;;
+ restart|force-reload)
+ #
+ # If the "reload" option is implemented, move the "force-reload"
+ # option to the "reload" entry above. If not, "force-reload" is
+ # just the same as "restart".
+ #
+ $0 stop
+ sleep 1
+ $0 start
+ ;;
+ *)
+ N=/etc/init.d/$NAME
+ # echo "Usage: $N {start|stop|restart|reload|force-reload}" >&2
+ echo "Usage: $N {start|stop|restart|force-reload}" >&2
+ exit 1
+ ;;
+esac
+
+exit 0
diff --git a/bin/freeside-session-kill b/bin/freeside-session-kill
new file mode 100755
index 0000000..d5fd703
--- /dev/null
+++ b/bin/freeside-session-kill
@@ -0,0 +1,103 @@
+#!/usr/bin/perl -w
+
+use strict;
+use vars qw($conf);
+use Fcntl qw(:flock);
+use FS::UID qw(adminsuidsetup datasrc dbh);
+use FS::Record qw(dbdef qsearch fields);
+use FS::session;
+use FS::svc_acct;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $sessionlock = "/usr/local/etc/freeside/session-kill.lock.". datasrc;
+
+open(LOCK,"+>>$sessionlock") or die "Can't open $sessionlock: $!";
+select(LOCK); $|=1; select(STDOUT);
+unless ( flock(LOCK,LOCK_EX|LOCK_NB) ) {
+ seek(LOCK,0,0);
+ my($pid)=<LOCK>;
+ chop($pid);
+ #no reason to start loct of blocking processes
+ die "Is another session kill process running under pid $pid?\n";
+}
+seek(LOCK,0,0);
+print LOCK $$,"\n";
+
+$FS::UID::AutoCommit = 0;
+
+my $now = time;
+
+#uhhhhh
+
+use DBIx::DBSchema;
+use DBIx::DBSchema::Table; #down this path lies madness
+use DBIx::DBSchema::Column;
+
+my $dbdef = dbdef or die;
+#warn $dbdef;
+#warn $dbdef->{'tables'};
+#warn keys %{$dbdef->{'tables'}};
+my $session_table = $dbdef->table('session') or die;
+my $svc_acct_table = $dbdef->table('svc_acct') or die;
+
+my $session_svc_acct = new DBIx::DBSchema::Table ( 'session,svc_acct', '', '', '',
+ map( DBIx::DBSchema::Column->new( "session.$_",
+ $session_table->column($_)->type,
+ $session_table->column($_)->null,
+ $session_table->column($_)->length,
+ ), $session_table->columns() ),
+ map( DBIx::DBSchema::Column->new( "svc_acct.$_",
+ $svc_acct_table->column($_)->type,
+ $svc_acct_table->column($_)->null,
+ $svc_acct_table->column($_)->length,
+ ), $svc_acct_table->columns ),
+# map("svc_acct.$_", $svc_acct_table->columns),
+);
+
+$dbdef->addtable($session_svc_acct); #madness, i tell you
+
+$FS::Record::DEBUG = 1;
+my @session = qsearch('session,svc_acct', {}, '', ' WHERE '. join(' AND ',
+ 'svc_acct.svcnum = session.svcnum',
+ '( session.logout IS NULL OR session.logout = 0 )',
+ "( $now - session.login ) >= svc_acct.seconds"
+). " FOR UPDATE" );
+
+my $dbh = dbh;
+
+foreach my $join ( @session ) {
+
+ my $session = new FS::session ( {
+ map { $_ => $join->{'Hash'}{"session.$_"} } fields('session')
+ } ); #see no evil
+
+ my $svc_acct = new FS::svc_acct ( {
+ map { $_ => $join->{'Hash'}{"svc_acct.$_"} } fields('svc_acct')
+ } );
+
+ #false laziness w/ fs_session_server
+ my $nsession = new FS::session ( { $session->hash } );
+ my $error = $nsession->replace($session);
+ if ( $error ) {
+ $dbh->rollback;
+ die $error;
+ }
+ my $time = $nsession->logout - $nsession->login;
+ my $new_svc_acct = new FS::svc_acct ( { $svc_acct->hash } );
+ my $seconds = $new_svc_acct->seconds;
+ $seconds -= $time;
+ $seconds = 0 if $seconds < 0;
+ $new_svc_acct->seconds( $seconds );
+ $error = $new_svc_acct->replace( $svc_acct );
+ warn "can't debit time from ". $svc_acct->username. ": $error\n"; #don't want to rollback, though
+ #ssenizal eslaf
+
+}
+
+$dbh->commit or die $dbh->errstr;
+
+sub usage {
+ die "Usage:\n\n freeside-session-kill user\n";
+}
diff --git a/bin/fs-migrate-part_svc b/bin/fs-migrate-part_svc
new file mode 100755
index 0000000..b0f3ac5
--- /dev/null
+++ b/bin/fs-migrate-part_svc
@@ -0,0 +1,41 @@
+#!/usr/bin/perl
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch fields);
+use FS::part_svc;
+
+my $user = shift or die &usage;
+my $dbh = adminsuidsetup $user;
+
+my $oldAutoCommit = $FS::UID::AutoCommit;
+local $FS::UID::AutoCommit = 0;
+
+foreach my $part_svc ( qsearch('part_svc', {} ) ) {
+ foreach my $field (
+ grep { defined($part_svc->getfield($part_svc->svcdb.'__'.$_.'_flag') ) }
+ fields($part_svc->svcdb)
+ ) {
+ my $flag = $part_svc->getfield($part_svc->svcdb.'__'.$field.'_flag');
+ if ( uc($flag) =~ /^([DF])$/ ) {
+ my $part_svc_column = new FS::part_svc_column {
+ 'svcpart' => $part_svc->svcpart,
+ 'columnname' => $field,
+ 'columnflag' => $1,
+ 'columnvalue' => $part_svc->getfield($part_svc->svcdb.'__'.$field),
+ };
+ my $error = $part_svc_column->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ die $error;
+ }
+ }
+ }
+}
+
+$dbh->commit or die $dbh->errstr;
+
+sub usage {
+ die "Usage:\n fs-migrate-part_svc user\n";
+}
+
diff --git a/bin/fs-migrate-payref b/bin/fs-migrate-payref
new file mode 100755
index 0000000..1584197
--- /dev/null
+++ b/bin/fs-migrate-payref
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+use FS::cust_pay;
+use FS::cust_refund;
+
+my $user = shift or die &usage;
+my $dbh = adminsuidsetup $user;
+
+# apply payments to invoices
+
+foreach my $cust_pay ( qsearch('cust_pay', {} ) ) {
+ my $error = $cust_pay->upgrade_replace;
+ warn $error if $error;
+}
+
+# apply refunds to credits
+
+foreach my $cust_refund ( qsearch('cust_refund') ) {
+ my $error = $cust_refund->upgrade_replace;
+ warn $error if $error;
+}
+
+# ? apply credits to invoices
+
+sub usage {
+ die "Usage:\n fs-migrate-payref user\n";
+}
+
diff --git a/bin/fs-migrate-svc_acct_sm b/bin/fs-migrate-svc_acct_sm
new file mode 100755
index 0000000..e34b235
--- /dev/null
+++ b/bin/fs-migrate-svc_acct_sm
@@ -0,0 +1,229 @@
+#!/usr/bin/perl -Tw
+#
+# $Id: fs-migrate-svc_acct_sm,v 1.4 2002-06-21 09:13:16 ivan Exp $
+#
+# jeff@cmh.net 01-Jul-20
+
+#to delay loading dbdef until we're ready
+#BEGIN { $FS::Record::setup_hack = 1; }
+
+use strict;
+use Term::Query qw(query);
+#use DBI;
+#use DBIx::DBSchema;
+#use DBIx::DBSchema::Table;
+#use DBIx::DBSchema::Column;
+#use DBIx::DBSchema::ColGroup::Unique;
+#use DBIx::DBSchema::ColGroup::Index;
+use FS::Conf;
+use FS::UID qw(adminsuidsetup datasrc checkeuid getsecrets);
+use FS::Record qw(qsearch qsearchs);
+use FS::svc_domain;
+use FS::svc_forward;
+use vars qw( $conf $old_default_domain %part_domain_svc %part_acct_svc %part_forward_svc $svc_acct $svc_acct_sm $error);
+
+die "Not running uid freeside!" unless checkeuid();
+
+my $user = shift or die &usage;
+getsecrets($user);
+
+$conf = new FS::Conf;
+$old_default_domain = $conf->config('domain');
+
+#needs to match FS::Record
+#my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc;
+
+###
+# This section would be the appropriate place to manipulate
+# the schema & tables.
+###
+
+## we need to add the domsvc to svc_acct
+## we must add a svc_forward record....
+## I am thinking that the fields svcnum (int), destsvc (int), and
+## dest (varchar (80)) are appropriate, with destsvc/dest an either/or
+## much in the spirit of cust_main_invoice
+
+###
+# massage the data
+###
+
+my($dbh)=adminsuidsetup $user;
+
+$|=1;
+
+$FS::svc_Common::noexport_hack = 1;
+$FS::svc_domain::whois_hack = 1;
+
+%part_domain_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_domain'});
+%part_acct_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+%part_forward_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_forward'});
+
+die "No services with svcdb svc_domain!\n" unless %part_domain_svc;
+die "No services with svcdb svc_acct!\n" unless %part_acct_svc;
+die "No services with svcdb svc_forward!\n" unless %part_forward_svc;
+
+my($svc_domain) = qsearchs('svc_domain', { 'domain' => $old_default_domain });
+if (! $svc_domain || $svc_domain->domain != $old_default_domain) {
+ print <<EOF;
+
+Your database currently does not contain a svc_domain record for the
+domain $old_default_domain. Would you like me to add one for you?
+EOF
+
+ my($response)=scalar(<STDIN>);
+ chop $response;
+ if ($response =~ /^[yY]/) {
+ print "\n\n", &menu_domain_svc, "\n", <<END;
+I need to create new domain accounts. Which service shall I use for that?
+END
+ my($domain_svcpart)=&getdomainpart;
+
+ $svc_domain = new FS::svc_domain {
+ 'domain' => $old_default_domain,
+ 'svcpart' => $domain_svcpart,
+ 'action' => 'M',
+ };
+# $error=$svc_domain->insert && die "Error adding domain $old_default_domain: $error";
+ $error=$svc_domain->insert;
+ die "Error adding domain $old_default_domain: $error" if $error;
+ }else{
+ print <<EOF;
+
+ This program cannot function properly until a svc_domain record matching
+your conf_dir/domain file exists.
+EOF
+
+ exit 1;
+ }
+}
+
+print "\n\n", &menu_acct_svc, "\n", <<END;
+I may need to create some new pop accounts and set up forwarding to them
+for some users. Which service shall I use for that?
+END
+my($pop_svcpart)=&getacctpart;
+
+print "\n\n", &menu_forward_svc, "\n", <<END;
+I may need to create some new forwarding for some users. Which service
+shall I use for that?
+END
+my($forward_svcpart)=&getforwardpart;
+
+sub menu_domain_svc {
+ ( join "\n", map "$_: ".$part_domain_svc{$_}->svc, sort keys %part_domain_svc ). "\n";
+}
+sub menu_acct_svc {
+ ( join "\n", map "$_: ".$part_acct_svc{$_}->svc, sort keys %part_acct_svc ). "\n";
+}
+sub menu_forward_svc {
+ ( join "\n", map "$_: ".$part_forward_svc{$_}->svc, sort keys %part_forward_svc ). "\n";
+}
+sub getdomainpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_domain_svc ];
+ $^W=1;
+ $return;
+}
+sub getacctpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_acct_svc ];
+ $^W=1;
+ $return;
+}
+sub getforwardpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_forward_svc ];
+ $^W=1;
+ $return;
+}
+
+
+#migrate data
+
+my(@svc_accts) = qsearch('svc_acct', {});
+foreach $svc_acct (@svc_accts) {
+ my(@svc_acct_sms) = qsearch('svc_acct_sm', {
+ domuid => $svc_acct->getfield('uid'),
+ }
+ );
+
+ # Ok.. we've got the svc_acct record, and an array of svc_acct_sm's
+ # What do we do from here?
+
+ # The intuitive:
+ # plop the svc_acct into the 'default domain'
+ # and then represent the svc_acct_sm's with svc_forwards
+ # they can be gussied up manually, later
+ #
+ # Perhaps better:
+ # when no svc_acct_sm exists, place svc_acct in 'default domain'
+ # when one svc_acct_sm exists, place svc_acct in corresponding
+ # domain & possibly create a svc_forward in 'default domain'
+ # when multiple svc_acct_sm's exists (in different domains) we'd
+ # better use the 'intuitive' approach.
+ #
+ # Specific way:
+ # as 'perhaps better,' but we may be able to guess which domain
+ # is correct by comparing the svcnum of domains to the username
+ # of the svc_acct
+ #
+
+ # The intuitive way:
+
+ my $def_acct = new FS::svc_acct ( { $svc_acct->hash } );
+ $def_acct->setfield('domsvc' => $svc_domain->getfield('svcnum'));
+ $error = $def_acct->replace($svc_acct);
+ die "Error replacing svc_acct for " . $def_acct->username . " : $error" if $error;
+
+ foreach $svc_acct_sm (@svc_acct_sms) {
+
+ my($domrec)=qsearchs('svc_domain', {
+ svcnum => $svc_acct_sm->getfield('domsvc'),
+ }) || die "svc_acct_sm references invalid domsvc $svc_acct_sm->getfield('domsvc')\n";
+
+ if ($svc_acct_sm->getfield('domuser') =~ /^\*$/) {
+
+ my($newdom) = new FS::svc_domain ( { $domrec->hash } );
+ $newdom->setfield('catchall', $svc_acct->svcnum);
+ $newdom->setfield('action', "M");
+ $error = $newdom->replace($domrec);
+ die "Error replacing svc_domain for (anything)@" . $domrec->domain . " : $error" if $error;
+
+ } else {
+
+ my($newacct) = new FS::svc_acct {
+ 'svcpart' => $pop_svcpart,
+ 'username' => $svc_acct_sm->getfield('domuser'),
+ 'domsvc' => $svc_acct_sm->getfield('domsvc'),
+ 'dir' => '/dev/null',
+ };
+ $error = $newacct->insert;
+ die "Error adding svc_acct for " . $newacct->username . " : $error" if $error;
+
+ my($newforward) = new FS::svc_forward {
+ 'svcpart' => $forward_svcpart,
+ 'srcsvc' => $newacct->getfield('svcnum'),
+ 'dstsvc' => $def_acct->getfield('svcnum'),
+ };
+ $error = $newforward->insert;
+ die "Error adding svc_forward for " . $newacct->username ." : $error" if $error;
+ }
+
+ $error = $svc_acct_sm->delete;
+ die "Error deleting svc_acct_sm for " . $svc_acct_sm->domuser ." : $error" if $error;
+
+ };
+
+};
+
+
+$dbh->commit or die $dbh->errstr;
+$dbh->disconnect or die $dbh->errstr;
+
+print "svc_acct_sm records sucessfully migrated\n";
+
+sub usage {
+ die "Usage:\n fs-migrate-svc_acct_sm user\n";
+}
+
diff --git a/bin/fs-radius-add-check b/bin/fs-radius-add-check
new file mode 100755
index 0000000..4e4769e
--- /dev/null
+++ b/bin/fs-radius-add-check
@@ -0,0 +1,68 @@
+#!/usr/bin/perl -Tw
+
+# quick'n'dirty hack of fs-setup to add radius attributes
+
+use strict;
+use DBI;
+use FS::UID qw(adminsuidsetup checkeuid getsecrets);
+use FS::raddb;
+
+die "Not running uid freeside!" unless checkeuid();
+
+my %attrib2db =
+ map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib;
+
+my $user = shift or die &usage;
+getsecrets($user);
+
+my $dbh = adminsuidsetup $user;
+
+###
+
+print "\n\n", <<END, ":";
+Enter the additional RADIUS check attributes you need to track for
+each user, separated by whitespace.
+END
+my @attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; }
+ split(" ",&getvalue);
+
+sub getvalue {
+ my($x)=scalar(<STDIN>);
+ chop $x;
+ $x;
+}
+
+###
+
+my($char_d) = 80; #default maxlength for text fields
+
+###
+
+foreach my $attribute ( @attributes ) {
+
+ my $statement =
+ "ALTER TABLE svc_acct ADD COLUMN rc_$attribute varchar($char_d) NULL";
+ my $sth = $dbh->prepare( $statement )
+ or warn "Error preparing $statement: ". $dbh->errstr;
+ my $rc = $sth->execute
+ or warn "Error executing $statement: ". $sth->errstr;
+
+ $statement =
+ "ALTER TABLE h_svc_acct ADD COLUMN rc_$attribute varchar($char_d) NULL";
+ $sth = $dbh->prepare( $statement )
+ or warn "Error preparing $statement: ". $dbh->errstr;
+ $rc = $sth->execute
+ or warn "Error executing $statement: ". $sth->errstr;
+
+}
+
+$dbh->commit or die $dbh->errstr;
+
+$dbh->disconnect or die $dbh->errstr;
+
+print "\n\n", "Now you must run dbdef-create.\n\n";
+
+sub usage {
+ die "Usage:\n fs-radius-add-check user\n";
+}
+
diff --git a/bin/fs-radius-add-reply b/bin/fs-radius-add-reply
new file mode 100755
index 0000000..3de0137
--- /dev/null
+++ b/bin/fs-radius-add-reply
@@ -0,0 +1,69 @@
+#!/usr/bin/perl -Tw
+
+# quick'n'dirty hack of fs-setup to add radius attributes
+
+use strict;
+use DBI;
+use FS::UID qw(adminsuidsetup checkeuid getsecrets);
+use FS::raddb;
+
+die "Not running uid freeside!" unless checkeuid();
+
+my %attrib2db =
+ map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib;
+
+my $user = shift or die &usage;
+getsecrets($user);
+
+my $dbh = adminsuidsetup $user;
+
+###
+
+print "\n\n", <<END, ":";
+Enter the additional RADIUS reply attributes you need to track for
+each user, separated by whitespace.
+END
+my @attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; }
+ split(" ",&getvalue);
+
+sub getvalue {
+ my($x)=scalar(<STDIN>);
+ chop $x;
+ $x;
+}
+
+###
+
+my($char_d) = 80; #default maxlength for text fields
+
+###
+
+foreach my $attribute ( @attributes ) {
+
+ my $statement =
+ "ALTER TABLE svc_acct ADD COLUMN radius_$attribute varchar($char_d) NULL";
+ my $sth = $dbh->prepare( $statement )
+ or warn "Error preparing $statement: ". $dbh->errstr;
+ my $rc = $sth->execute
+ or warn "Error executing $statement: ". $sth->errstr;
+
+ $statement =
+ "ALTER TABLE h_svc_acct ADD COLUMN radius_$attribute varchar($char_d) NULL";
+ $sth = $dbh->prepare( $statement )
+ or warn "Error preparing $statement: ". $dbh->errstr;
+ $rc = $sth->execute
+ or warn "Error executing $statement: ". $sth->errstr;
+
+}
+
+$dbh->commit or die $dbh->errstr;
+
+$dbh->disconnect or die $dbh->errstr;
+
+print "\n\n", "Now you must run dbdef-create.\n\n";
+
+sub usage {
+ die "Usage:\n fs-radius-add-reply user\n";
+}
+
+
diff --git a/bin/generate-prepay b/bin/generate-prepay
new file mode 100755
index 0000000..cb4ba7f
--- /dev/null
+++ b/bin/generate-prepay
@@ -0,0 +1,35 @@
+#!/usr/bin/perl -w
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::prepay_credit;
+
+require 5.004; #srand(time|$$);
+
+my $user = shift or die &usage;
+&adminsuidsetup( $user );
+
+my $amount = shift or die &usage;
+
+my $seconds = shift or die &usage;
+
+my $num_digits = shift or die &usage;
+
+my $num_entries = shift or die &usage;
+
+for ( 1 .. $num_entries ) {
+ my $identifier = join( '', map int(rand(10)), ( 1 .. $num_digits ) );
+ my $prepay_credit = new FS::prepay_credit {
+ 'identifier' => $identifier,
+ 'amount' => $amount,
+ 'seconds' => $seconds,
+ };
+ my $error = $prepay_credit->insert;
+ die $error if $error;
+ print "$identifier\n";
+}
+
+sub usage {
+ die "Usage:\n\n generate-prepay user amount seconds num_digits num_entries";
+}
+
diff --git a/bin/generate-raddb b/bin/generate-raddb
new file mode 100755
index 0000000..f946b05
--- /dev/null
+++ b/bin/generate-raddb
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+
+# usage: generate-raddb radius-server/raddb/dictionary* >raddb.pm
+# i.e.: generate-raddb ~/src/freeradius-0.2/raddb/dictionary* >FS/raddb.pm
+
+print <<END;
+package FS::raddb;
+use vars qw(%attrib);
+
+%attrib = (
+END
+
+while (<>) {
+ next if /^(#|\s*$|\$INCLUDE\s+)/;
+ next if /^(VALUE|VENDOR|BEGIN\-VENDOR|END\-VENDOR)\s+/;
+ /^(ATTRIBUTE|ATTRIB_NMC)\s+([\w\-\/]+)\s+/ or die $_;
+ $attrib = $2;
+ $dbname = lc($2);
+ $dbname =~ s/[\-\/]/_/g;
+ $dbname = substr($dbname,0,24);
+ while ( exists $hash{$dbname} ) {
+ #warn $dbname;
+ $dbname =~ s/(.)$//;
+ my $w = $1;
+ $w =~ tr/_a-z0-9/a-z0-9_/;
+ $dbname = "$dbname$w";
+ }
+ $hash{$dbname} = $attrib;
+ #print "$2\n";
+}
+
+foreach ( keys %hash ) {
+# print "$_\n" if length($_)>24;
+# print substr($_,0,24),"\n" if length($_)>24;
+# $max = length($_) if length($_)>$max;
+# have to fudge things since everything >24 is *not* unique
+
+ #print " '". substr($_,0,24). "' => '$hash{$_}',\n";
+ print " '$_' => '$hash{$_}',\n";
+}
+
+print <<END;
+);
+
+1;
+END
+
diff --git a/bin/generate-tests b/bin/generate-tests
new file mode 100755
index 0000000..73fd29e
--- /dev/null
+++ b/bin/generate-tests
@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+@files = glob('FS/*.pm');
+foreach (@files) {
+# warn $_;
+ chomp;
+ s/^FS\///;
+ $f=$_;
+ $f=~s/pm$/t/;
+ $m=$_;
+ $m=~s/\.pm$//;
+ open(TEST,">t/$f");
+ print "t/$f\n";
+ print TEST
+ 'BEGIN { $| = 1; print "1..1\n" }'. "\n".
+ 'END {print "not ok 1\n" unless $loaded;}'. "\n".
+ "use FS::$m;\n".
+ '$loaded=1;'. "\n".
+ 'print "ok 1\n";'. "\n"
+ ;
+ close TEST;
+}
diff --git a/bin/masonize b/bin/masonize
new file mode 100755
index 0000000..3139e0a
--- /dev/null
+++ b/bin/masonize
@@ -0,0 +1,72 @@
+#!/usr/bin/perl
+
+foreach $file ( split(/\n/, `find . -depth -print`) ) {
+ next unless $file =~ /(cgi|html)$/;
+ open(F,$file) or die "can't open $file for reading: $!";
+ @file = <F>;
+ #print "$file ". scalar(@file). "\n";
+ close $file;
+ system("chmod u+w $file");
+ open(W,">$file") or die "can't open $file for writing: $!";
+ select W; $| = 1; select STDOUT;
+ $newline = ''; #avoid prepending extraneous newlines
+ $all = join('',@file);
+
+ $mode = 'html';
+ while ( length($all) ) {
+
+ if ( $mode eq 'html' ) {
+
+ if ( $all =~ /^(.+?)(<%=?.*)$/s && $1 !~ /<%/s ) {
+ print W $1;
+ $all = $2;
+ next;
+ } elsif ( $all =~ /^<%=(.*)$/s ) {
+ print W '<%';
+ $all = $1;
+ $mode = 'perlv';
+ #die;
+ next;
+ } elsif ( $all =~ /^<%(.*)$/s ) {
+ print W $newline; $newline = "\n";
+ $all = $1;
+ $mode = 'perlc';
+ next;
+ } elsif ( $all !~ /<%/s ) {
+ print W $all;
+ last;
+ } else {
+ warn length($all); die;
+ }
+ die;
+
+ } elsif ( $mode eq 'perlv' ) {
+
+ if ( $all =~ /^(.*?%>)(.*)$/s ) {
+ print W $1;
+ $all=$2;
+ $mode = 'html';
+ next;
+ }
+ die 'unterminated <%= ???';
+
+ } elsif ( $mode eq 'perlc' ) {
+
+ if ( $all =~ /^([^\n]*?)%>(.*)$/s ) {
+ print W "%$1\n";
+ $all=$2;
+ $mode='html';
+ next;
+ }
+ if ( $all =~ /^([^\n]*)\n(.*)$/s ) {
+ print W "%$1\n";
+ $all=$2;
+ next;
+ }
+
+ } else { die };
+
+ }
+
+ close W;
+}
diff --git a/bin/passwd.import b/bin/passwd.import
new file mode 100755
index 0000000..093f8ba
--- /dev/null
+++ b/bin/passwd.import
@@ -0,0 +1,120 @@
+#!/usr/bin/perl -Tw
+# $Id: passwd.import,v 1.8 2003-06-12 14:08:00 ivan Exp $
+
+use strict;
+use vars qw(%part_svc);
+use Date::Parse;
+use Term::Query qw(query);
+use Net::SCP qw(iscp);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch qsearchs);
+use FS::svc_acct;
+use FS::part_svc;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others?
+
+my($spooldir)="/usr/local/etc/freeside/export.". datasrc;
+
+#$FS::svc_acct::nossh_hack = 1;
+$FS::svc_Common::noexport_hack = 1;
+
+###
+
+%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+
+die "No services with svcdb svc_acct!\n" unless %part_svc;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Enter part number to import.
+END
+my($shell_svcpart)=&getpart;
+
+print "\n\n", <<END;
+Enter the location and name of your _user_ passwd file, for example
+"mail.isp.com:/etc/passwd" or "nis.isp.com:/etc/global/passwd"
+END
+my($loc_passwd)=&getvalue(":");
+iscp("root\@$loc_passwd", "$spooldir/passwd.import");
+
+print "\n\n", <<END;
+Enter the location and name of your _user_ shadow file, for example
+"mail.isp.com:/etc/shadow" or "bsd.isp.com:/etc/master.passwd"
+END
+my($loc_shadow)=&getvalue(":");
+iscp("root\@$loc_shadow", "$spooldir/shadow.import");
+
+sub menu_svc {
+ ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
+}
+sub getpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_svc ];
+ $^W=1;
+ $return;
+}
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
+}
+
+print "\n\n";
+
+###
+
+open(PASSWD,"<$spooldir/passwd.import");
+open(SHADOW,"<$spooldir/shadow.import");
+
+my(%password);
+while (<SHADOW>) {
+ chop;
+ my($username,$password)=split(/:/);
+ #$password =~ s/^\!$/\*/;
+ #$password =~ s/\!+/\*SUSPENDED\* /;
+ $password{$username}=$password;
+}
+
+while (<PASSWD>) {
+ chop;
+ my($username,$x,$uid,$gid,$finger,$dir,$shell) = split(/:/);
+ my $password = $password{$username};
+
+ my $svcpart = $shell_svcpart;
+
+ #if ( qsearchs('svc_acct', { 'username' => $username } ) ) {
+ # warn "warning: $username already exists; skipping\n";
+ # next;
+ #}
+
+ my($svc_acct) = new FS::svc_acct ({
+ 'svcpart' => $svcpart,
+ 'username' => $username,
+ '_password' => $password,
+ 'uid' => $uid,
+ 'gid' => $gid,
+ 'finger' => $finger,
+ 'dir' => $dir,
+ 'shell' => $shell,
+ #%{$allparam{$username}},
+ });
+ my($error);
+ $error=$svc_acct->insert;
+ if ( $error ) {
+ if ( $error =~ /duplicate/i ) {
+ warn "$username: $error";
+ } else {
+ die "$username: $error";
+ }
+ }
+
+}
+
+sub usage {
+ die "Usage:\n\n passwd.import user\n";
+}
+
diff --git a/bin/pod2x b/bin/pod2x
new file mode 100755
index 0000000..46ccc77
--- /dev/null
+++ b/bin/pod2x
@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+
+#use Pod::Text;
+#$Pod::Text::termcap=1;
+
+my $site_perl = "./FS";
+#my $catman = "./catman";
+#my $catman = "./htdocs/docs/man";
+#my $html = "./htdocs/docs/man";
+my $html = "./httemplate/docs/man";
+
+$|=1;
+
+die "Can't find $site_perl" unless -d $site_perl;
+#die "Can't find $catman" unless -d $catman;
+die "Can't find $html" unless -d $html;
+
+#make some useless links
+foreach my $file (
+ glob("$site_perl/bin/freeside-*"),
+) {
+ next if $file =~ /\.pod$/;
+ #symlink $file, "$file.pod"; # or die "link $file to $file.pod: $!";
+ system("cp $file $file.pod");
+}
+
+foreach my $file (
+ glob("$site_perl/*.pm"),
+ glob("$site_perl/*/*.pm"),
+ glob("$site_perl/*/*/*.pm"),
+ glob("$site_perl/bin/*.pod"),
+ glob("./fs_sesmon/FS-SessionClient/*.pm"),
+ glob("./fs_signup/FS-SignupClient/*.pm"),
+ glob("./fs_selfadmin/FS-MailAdminServer/*.pm"),
+) {
+ next if $file =~ /(^|\/)blib\//;
+ #$file =~ /\/([\w\-]+)\.pm$/ or die "oops file $file";
+ my $name;
+ if ( $file =~ /fs_\w+\/FS\-\w+\/(.*)\.pm$/ ) {
+ $name = "FS/$1";
+ } elsif ( $file =~ /$site_perl\/(.*)\.(pm|pod)$/ ) {
+ $name = $1;
+ } else {
+ die "oops file $file";
+ }
+ print "$name\n";
+ my $htmlroot = join('/', map '..',1..(scalar($file =~ tr/\///)-2)) || '.';
+# system "pod2text $file >$catman/$name.txt";
+ system "pod2html --podroot=$site_perl --podpath=./FS:./FS/UI:.:./bin --norecurse --htmlroot=$htmlroot $file >$html/$name.html";
+ #system "pod2html --podroot=$site_perl --htmlroot=$htmlroot $file >$html/$name.html";
+# system "pod2html $file >$html/$name.html";
+}
+
+#remove the useless links
+unlink glob("$site_perl/bin/*.pod");
+
diff --git a/bin/populate-msgcat b/bin/populate-msgcat
new file mode 100755
index 0000000..719d330
--- /dev/null
+++ b/bin/populate-msgcat
@@ -0,0 +1,127 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+use FS::msgcat;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+foreach my $del_msgcat ( qsearch('msgcat', {}) ) {
+ my $error = $del_msgcat->delete;
+ die $error if $error;
+}
+
+my %messages = messages();
+
+foreach my $msgcode ( keys %messages ) {
+ foreach my $locale ( keys %{$messages{$msgcode}} ) {
+ my $msgcat = new FS::msgcat( {
+ 'msgcode' => $msgcode,
+ 'locale' => $locale,
+ 'msg' => $messages{$msgcode}{$locale},
+ });
+ my $error = $msgcat->insert;
+ die $error if $error;
+ }
+}
+
+#print "Message catalog initialized sucessfully\n";
+
+sub messages {
+
+ # 'msgcode' => {
+ # 'en_US' => 'Message',
+ # },
+
+ (
+
+ 'passwords_dont_match' => {
+ 'en_US' => "Passwords don't match",
+ },
+
+ 'invalid_card' => {
+ 'en_US' => 'Invalid credit card number',
+ },
+
+ 'unknown_card_type' => {
+ 'en_US' => 'Unknown card type',
+ },
+
+ 'not_a' => {
+ 'en_US' => 'Not a ',
+ },
+
+ 'empty_password' => {
+ 'en_US' => 'Empty password',
+ },
+
+ 'no_access_number_selected' => {
+ 'en_US' => 'No access number selected',
+ },
+
+ 'illegal_text' => {
+ 'en_US' => 'Illegal (text)',
+ #'en_US' => 'Only letters, numbers, spaces, and the following punctuation symbols are permitted: ! @ # $ % & ( ) - + ; : \' " , . ? / in field',
+ },
+
+ 'illegal_or_empty_text' => {
+ 'en_US' => 'Illegal or empty (text)',
+ #'en_US' => 'Only letters, numbers, spaces, and the following punctuation symbols are permitted: ! @ # $ % & ( ) - + ; : \' " , . ? / in required field',
+ },
+
+ 'illegal_username' => {
+ 'en_US' => 'Illegal username',
+ },
+
+ 'illegal_password' => {
+ 'en_US' => 'Illegal password (',
+ },
+
+ 'illegal_password_characters' => {
+ 'en_US' => ' characters)',
+ },
+
+ 'username_in_use' => {
+ 'en_US' => 'Username in use',
+ },
+
+ 'illegal_email_invoice_address' => {
+ 'en_US' => 'Illegal email invoice address',
+ },
+
+ 'illegal_name' => {
+ 'en_US' => 'Illegal (name)',
+ #'en_US' => 'Only letters, numbers, spaces and the following punctuation symbols are permitted: , . - \' in field',
+ },
+
+ 'illegal_phone' => {
+ 'en_US' => 'Illegal (phone)',
+ #'en_US' => '',
+ },
+
+ 'illegal_zip' => {
+ 'en_US' => 'Illegal (zip)',
+ #'en_US' => '',
+ },
+
+ 'expired_card' => {
+ 'en_US' => 'Expired card',
+ },
+
+ 'daytime' => {
+ 'en_US' => 'Day Phone',
+ },
+
+ 'night' => {
+ 'en_US' => 'Night Phone',
+ },
+
+ );
+}
+
+sub usage {
+ die "Usage:\n\n populate-msgcat user\n";
+}
+
diff --git a/bin/postfix.export b/bin/postfix.export
new file mode 100755
index 0000000..64d9738
--- /dev/null
+++ b/bin/postfix.export
@@ -0,0 +1,121 @@
+#!/usr/bin/perl -w
+
+use strict;
+#use File::Path;
+use File::Rsync;
+use Net::SSH qw(ssh);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch); # qsearchs);
+use FS::part_export;
+#use FS::cust_pkg;
+use FS::cust_svc;
+#use FS::svc_domain;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/postfix";
+mkdir $spooldir, 0700 unless -d $spooldir;
+
+my @exports = qsearch('part_export', { 'exporttype' => 'postfix' } );
+
+my $rsync = File::Rsync->new({
+ rsh => 'ssh',
+# dry_run => 1,
+});
+
+foreach my $export ( @exports ) {
+
+ my $machine = $export->machine;
+ my $prefix = "$spooldir/$machine";
+ mkdir $prefix, 0700 unless -d $prefix;
+
+ #construct %domain hash
+
+ my $mydomain = $export->option('mydomain');
+ my %domain;
+ foreach my $svc_forward ( $export->svc_x ) {
+
+ my( $username, $domain );
+ my $srcsvc_acct = $svc_forward->srcsvc_acct;
+ if ( $srcsvc_acct ) {
+ ( $username, $domain ) = ( $srcsvc_acct->username, $srcsvc_acct->domain );
+ } elsif ( $svc_forward->src =~ /([^@]*)\@([^@]+)$/ ) {
+ ( $username, $domain ) = ( $1, $2 );
+ } else {
+ die "bad svc_forward record? svcnum ". $svc_forward->svcnum. "\n";
+ }
+
+ my( $dusername, $ddomain );
+ my $dstsvc_acct = $svc_forward->dstsvc_acct;
+ if ( $dstsvc_acct ) {
+ $dusername = $dstsvc_acct->username;
+ $ddomain = $dstsvc_acct->domain;
+ } elsif ( $svc_forward->dst =~ /([^@]+)\@([^@]+)$/ ) {
+ ( $dusername, $ddomain ) = ( $1, $2 );
+ } else {
+ die "bad svc_forward record? svcnum ". $svc_forward->svcnum. "\n";
+ }
+ my $dest;
+ if ( $ddomain eq $mydomain ) {
+ $dest = $dusername;
+ } else {
+ $dest = "$dusername\@$ddomain";
+ }
+
+ push @{$domain{$domain}{$username}}, $dest;
+
+ }
+
+ #write aliases
+
+ my $aliases = delete $domain{$mydomain};
+ open(ALIASES, ">$prefix/aliases") or die "can't open $prefix/aliases: $!";
+ foreach my $alias ( keys %$aliases ) {
+ print ALIASES "$alias: ". join(',', @{ $aliases->{$alias} } ). "\n";
+ }
+ close ALIASES;
+
+ #write virtual
+
+ open(VIRTUAL, ">$prefix/virtual") or die "can't open $prefix/virtual: $!";
+ foreach my $domain ( keys %domain ) {
+ print VIRTUAL "$domain DOMAIN\n";
+ #foreach my $virtual ( sort { $a ne '' <=> $b ne '' } keys %{$domain{$domain}} ) {
+ foreach my $virtual ( sort { ( ($b ne '') <=> ($a ne '') ) || $a cmp $b } keys %{$domain{$domain}} ) {
+ print VIRTUAL "$virtual\@$domain ".
+ join(',', @{ $domain{$domain}{$virtual} } ). "\n";
+ }
+ print VIRTUAL "\n";
+ }
+ close VIRTUAL;
+
+ #rsync
+
+ my $user = $export->option('user');
+ $rsync->exec( {
+ src => "$prefix/aliases",
+ dest => "$user\@$machine:". $export->option('aliases'),
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+# warn $rsync->out;
+
+ ssh("$user\@$machine", "newaliases");
+# ssh("$user\@$machine", "postfix reload");
+
+ $rsync->exec( {
+ src => "$prefix/virtual",
+ dest => "$user\@$machine:". $export->option('virtual'),
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+# warn $rsync->out;
+ ssh("$user\@$machine", "postmap hash:/etc/postfix/virtual");
+ ssh("$user\@$machine", "postfix reload");
+
+}
+
+# -----
+
+sub usage {
+ die "Usage:\n postfix.export user\n";
+}
+
+
diff --git a/bin/sendmail.import b/bin/sendmail.import
new file mode 100644
index 0000000..8a9de9f
--- /dev/null
+++ b/bin/sendmail.import
@@ -0,0 +1,176 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Term::Query qw(query);
+use Net::SCP 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::domain_record;
+use FS::svc_acct;
+##use FS::part_svc;
+use FS::svc_forward;
+use FS::svc_domain;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+#$FS::svc_Common::noexport_hack = 1;
+#$FS::domain_record::noserial_hack = 1;
+
+use vars qw($defaultdomain);
+$defaultdomain = 'surferz.net';
+
+use vars qw($svcpart $forward_svcpart);
+$svcpart = 2;
+$forward_svcpart = 4;
+
+use vars qw($spooldir);
+$spooldir = "/usr/local/etc/freeside/export.". datasrc. "/sendmail";
+mkdir $spooldir unless -d $spooldir;
+
+print "\n\n", <<END;
+Enter the location and name of your Sendmail aliases file, for example
+"mail.isp.com:/etc/mail/aliases"
+END
+my($aliases)=&getvalue(":");
+
+use vars qw($aliases_machine $aliases_prefix);
+$aliases_machine = (split(/:/, $aliases))[0];
+$aliases_prefix = "$spooldir/$aliases_machine";
+mkdir $aliases_prefix unless -d $aliases_prefix;
+
+#iscp("root\@$aliases","$aliases_prefix/aliases.import");
+iscp("ivan\@$aliases","$aliases_prefix/aliases.import");
+
+print "\n\n", <<END;
+Enter the location and name of your Sendmail virtusertable directory, for example
+"mail.isp.com:/etc/mail/virtusertable"
+END
+my($virtusertable)=&getvalue(":");
+
+use vars qw($virtusertable_machine $virtusertable_prefix);
+$virtusertable_machine = (split(/:/, $virtusertable))[0];
+$virtusertable_prefix = "$spooldir/$virtusertable_machine";
+mkdir $virtusertable_prefix unless -d $virtusertable_prefix;
+mkdir "$virtusertable_prefix/virtusertable.import"
+ unless -d "$virtusertable_prefix/virtusertable.import";
+
+#iscp("root\@$virtusertable/*","$aliases_prefix/virtusertable.import/");
+iscp("ivan\@$virtusertable/*","$aliases_prefix/virtusertable.import/");
+
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
+}
+
+print "\n\n";
+
+##
+
+foreach my $file (
+ "$aliases_prefix/aliases.import",
+ glob("$aliases_prefix/virtusertable.import/*"),
+) {
+
+ warn "importing $file\n";
+
+ open(FILE,"<$file") or die $!;
+ while (<FILE>) {
+ next if /^\s*#/ || /^\s*$/; #skip comments & blank lines
+
+ unless ( /^([\w\@\.\-]+)[:\s]\s*(.*\S)\s*$/ ) {
+ warn "Unparsable line: $_";
+ next;
+ }
+ my($rawusername, $rawdest) = ($1, $2);
+
+ my($username, $domain);
+ if ( $rawusername =~ /^([\w\-\.\&]*)\@([\w\.\-]+)$/ ) {
+ $username = $1;
+ $domain = $2;
+ } elsif ( $rawusername =~ /\@/ ) {
+ die "Unparsable username: $rawusername\n";
+ } else {
+ $username = $rawusername;
+ $domain = $defaultdomain;
+ }
+
+ #find svc_acct record or set $src
+ my($srcsvc, $src) = &svcnum_or_literal($username, $domain);
+
+ foreach my $dest ( split(/,/, $rawdest) ) {
+
+ my($dusername, $ddomain);
+ if ( $dest =~ /^([\w\-\.\&]+)\@([\w\.\-]+)$/ ) {
+ $dusername = $1;
+ $ddomain = $2;
+ } elsif ( $dest =~ /\@/ ) {
+ die "Unparsable username: $dest\n";
+ } else {
+ $dusername = $dest;
+ $ddomain = $defaultdomain;
+ }
+ my($dstsvc, $dst) = &svcnum_or_literal($dusername, $ddomain);
+
+ my $svc_forward = new FS::svc_forward ({
+ svcpart => $forward_svcpart,
+ srcsvc => $srcsvc,
+ src => $src,
+ dstsvc => $dstsvc,
+ dst => $dst,
+ });
+ my $error = $svc_forward->insert;
+ #my $error = $svc_forward->check;
+ if ( $error ) {
+ die "$rawusername: $rawdest: $error\n";
+ }
+ }
+
+
+ } #next entry
+
+} #next file
+
+##
+
+sub svcnum_or_literal {
+ my($username, $domain) = @_;
+
+ my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } );
+ my $domsvc = $svc_domain ? $svc_domain->svcnum : '';
+
+ my @svc_acct = grep { $_->cust_svc->svcpart == $svcpart }
+ qsearch('svc_acct', {
+ 'username' => $username,
+ 'domsvc' => $domsvc,
+ });
+
+ if ( scalar(@svc_acct) > 1 ) {
+ die "multiple sources found for $username\@$domain !\n";
+ }
+
+ my( $svcnum, $literal ) = ('', '');
+ if ( @svc_acct ) {
+ my $svc_acct = $svc_acct[0];
+ $svcnum = $svc_acct->svcnum;
+ } else {
+ $literal = "$username\@$domain";
+ }
+
+ return( $svcnum, $literal );
+
+}
+
+sub usage {
+ die "Usage:\n\n sendmail.import user\n";
+}
+
+
+
+
+
diff --git a/bin/shadow.reimport b/bin/shadow.reimport
new file mode 100755
index 0000000..2c0ad1f
--- /dev/null
+++ b/bin/shadow.reimport
@@ -0,0 +1,98 @@
+#!/usr/bin/perl -Tw
+# $Id: shadow.reimport,v 1.1 2004-02-03 00:19:45 ivan Exp $
+
+use strict;
+use vars qw(%part_svc);
+use Term::Query qw(query);
+use Net::SCP qw(iscp);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch qsearchs);
+use FS::svc_acct;
+use FS::part_svc;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others?
+
+my($spooldir)="/usr/local/etc/freeside/export.". datasrc;
+
+#$FS::svc_acct::nossh_hack = 1;
+$FS::svc_Common::noexport_hack = 1;
+
+###
+
+%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+
+die "No services with svcdb svc_acct!\n" unless %part_svc;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Enter part number to import.
+END
+my($shell_svcpart)=&getpart;
+
+print "\n\n", <<END;
+Enter the location and name of your _user_ shadow file, for example
+"mail.isp.com:/etc/shadow" or "bsd.isp.com:/etc/master.passwd"
+END
+my($loc_shadow)=&getvalue(":");
+iscp("root\@$loc_shadow", "$spooldir/shadow.import");
+
+sub menu_svc {
+ ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
+}
+sub getpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_svc ];
+ $^W=1;
+ $return;
+}
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
+}
+
+print "\n\n";
+
+###
+
+open(SHADOW,"<$spooldir/shadow.import");
+
+my($line, $updated);
+while (<SHADOW>) {
+ $line++;
+ chop;
+ my($username,$password)=split(/:/);
+
+ my @svc_acct = grep { $_->cust_svc->svcpart == $shell_svcpart }
+ qsearch('svc_acct', { 'username' => $username } );
+
+ next unless @svc_acct;
+
+ if ( scalar(@svc_acct) > 1 ) {
+ warn "more than one $username found!\n";
+ next;
+ }
+
+ my $svc_acct = shift @svc_acct;
+
+ next if $svc_acct->_password eq $password;
+
+ my $new_svc_acct = new FS::svc_acct( { $svc_acct->hash } );
+ $new_svc_acct->_password($password);
+ #my $error = $new_svc_acct->replace($svc_acct);
+ #die "$username: $error" if $error;
+
+ $updated++;
+
+}
+
+warn "$updated of $line passwords changed\n";
+
+sub usage {
+ die "Usage:\n\n shadow.reimport user\n";
+}
+
diff --git a/bin/svc_acct.export b/bin/svc_acct.export
new file mode 100755
index 0000000..0bc370f
--- /dev/null
+++ b/bin/svc_acct.export
@@ -0,0 +1,641 @@
+#!/usr/bin/perl -w
+#
+# $Id: svc_acct.export,v 1.36 2002-05-16 14:28:35 ivan Exp $
+#
+# Create and export password, radius and vpopmail password files:
+# passwd, passwd.adjunct, shadow, acp_passwd, acp_userinfo, acp_dialup
+# users/assign, domains/vdomain/vpasswd
+# Also export sendmail and qmail config files.
+
+use strict;
+use vars qw($conf);
+use Fcntl qw(:flock);
+use File::Path;
+use IO::Handle;
+use FS::Conf;
+use Net::SSH qw(ssh);
+use Net::SCP qw(scp);
+use FS::UID qw(adminsuidsetup datasrc dbh);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::svc_acct;
+use FS::svc_domain;
+use FS::svc_forward;
+
+my $ssh='ssh';
+my $rsync='rsync';
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+$conf = new FS::Conf;
+
+my $userpolicy = $conf->config('username_policy')
+ if $conf->exists('username_policy');
+
+my @shellmachines = $conf->config('shellmachines')
+ if $conf->exists('shellmachines');
+
+my @bsdshellmachines = $conf->config('bsdshellmachines')
+ if $conf->exists('bsdshellmachines');
+
+my @nismachines = $conf->config('nismachines')
+ if $conf->exists('nismachines');
+
+my @erpcdmachines = $conf->config('erpcdmachines')
+ if $conf->exists('erpcdmachines');
+
+my @radiusmachines = $conf->config('radiusmachines')
+ if $conf->exists('radiusmachines');
+
+my $textradiusprepend =
+ $conf->exists('textradiusprepend')
+ ? $conf->config('textradiusprepend')
+ : '';
+
+warn "using depriciated textradiusprepend file" if $textradiusprepend;
+
+
+my $radiusprepend =
+ $conf->exists('radiusprepend')
+ ? join("\n", $conf->config('radiusprepend'))
+ : '';
+
+my @vpopmailmachines = $conf->config('vpopmailmachines')
+ if $conf->exists('vpopmailmachines');
+my $vpopmailrestart = '';
+$vpopmailrestart = $conf->config('vpopmailrestart')
+ if $conf->exists('vpopmailrestart');
+
+my ($machine, $vpopdir, $vpopuid, $vpopgid) = split (/\s+/, $vpopmailmachines[0]) if $vpopmailmachines[0];
+
+my($shellmachine, @qmailmachines);
+if ( $conf->exists('qmailmachines') ) {
+ $shellmachine = $conf->config('shellmachine');
+ @qmailmachines = $conf->config('qmailmachines');
+}
+
+my(@sendmailmachines, $sendmailconfigpath, $sendmailrestart);
+if ( $conf->exists('sendmailmachines') ) {
+ @sendmailmachines = $conf->config('sendmailmachines');
+ $sendmailconfigpath = $conf->config('sendmailconfigpath') || '/etc';
+ $sendmailrestart = $conf->config('sendmailrestart');
+}
+
+my $mydomain = $conf->config('domain') if $conf->exists('domain');
+
+
+
+
+my(@saltset)= ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
+require 5.004; #srand(time|$$);
+
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc;
+my $spoollock = "/usr/local/etc/freeside/svc_acct.export.lock.". datasrc;
+
+open(EXPORT,"+>>$spoollock") or die "Can't open $spoollock: $!";
+select(EXPORT); $|=1; select(STDOUT);
+unless ( flock(EXPORT,LOCK_EX|LOCK_NB) ) {
+ seek(EXPORT,0,0);
+ my($pid)=<EXPORT>;
+ chop($pid);
+ #no reason to start lots of blocking processes
+ die "Is another export process running under pid $pid?\n";
+}
+seek(EXPORT,0,0);
+print EXPORT $$,"\n";
+
+my(@svc_domain)=qsearch('svc_domain',{});
+
+( open(MASTER,">$spooldir/master.passwd")
+ and flock(MASTER,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/.master.passwd: $!";
+( open(PASSWD,">$spooldir/passwd")
+ and flock(PASSWD,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/passwd: $!";
+( open(SHADOW,">$spooldir/shadow")
+ and flock(SHADOW,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/shadow: $!";
+( open(ACP_PASSWD,">$spooldir/acp_passwd")
+ and flock(ACP_PASSWD,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/acp_passwd: $!";
+( open(ACP_DIALUP,">$spooldir/acp_dialup")
+ and flock(ACP_DIALUP,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/acp_dialup: $!";
+( open(USERS,">$spooldir/users")
+ and flock(USERS,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/users: $!";
+
+( open(ASSIGN,">$spooldir/assign")
+ and flock(ASSIGN,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/assign: $!";
+( open(RCPTHOSTS,">$spooldir/rcpthosts")
+ and flock(RCPTHOSTS,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/rcpthosts: $!";
+( open(VPOPRCPTHOSTS,">$spooldir/vpoprcpthosts")
+ and flock(VPOPRCPTHOSTS,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/rcpthosts: $!";
+( open(RECIPIENTMAP,">$spooldir/recipientmap")
+ and flock(RECIPIENTMAP,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/recipientmap: $!";
+( open(VIRTUALDOMAINS,">$spooldir/virtualdomains")
+ and flock(VIRTUALDOMAINS,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/virtualdomains: $!";
+( open(VPOPVIRTUALDOMAINS,">$spooldir/vpopvirtualdomains")
+ and flock(VPOPVIRTUALDOMAINS,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/virtualdomains: $!";
+( open(VIRTUSERTABLE,">$spooldir/virtusertable")
+ and flock(VIRTUSERTABLE,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/virtusertable: $!";
+( open(SENDMAIL_CW,">$spooldir/sendmail.cw")
+ and flock(SENDMAIL_CW,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/sendmail.cw: $!";
+
+
+
+chmod 0644, "$spooldir/passwd",
+ "$spooldir/acp_dialup",
+ "$spooldir/assign",
+ "$spooldir/sendmail.cw",
+ "$spooldir/virtusertable",
+ "$spooldir/rcpthosts",
+ "$spooldir/vpoprcpthosts",
+ "$spooldir/recipientmap",
+ "$spooldir/virtualdomains",
+ "$spooldir/vpopvirtualdomains",
+
+;
+chmod 0600, "$spooldir/master.passwd",
+ "$spooldir/acp_passwd",
+ "$spooldir/shadow",
+ "$spooldir/users",
+;
+
+rmtree"$spooldir/domains", 0, 1;
+mkdir "$spooldir/domains", 0700;
+
+setpriority(0,0,10);
+
+print USERS "$radiusprepend\n";
+
+my %usernames; ## this hack helps keep the passwd files sane
+my @sendmail;
+
+my $svc_domain;
+foreach $svc_domain (sort {$a->domain cmp $b->domain} @svc_domain) {
+
+ my($domain)=$svc_domain->domain;
+ print RCPTHOSTS "$domain\n.$domain\n";
+ print VPOPRCPTHOSTS "$domain\n";
+ print SENDMAIL_CW "$domain\n";
+
+ ###
+ # FORMAT OF THE ASSIGN/USERS FILE HERE
+ print ASSIGN join(":",
+ "+" . $domain . "-",
+ $domain,
+ $vpopuid,
+ $vpopgid,
+ $vpopdir . "/domains/" . $domain,
+ "-",
+ "",
+ "",
+ ), "\n" if $vpopmailmachines[0];
+
+ (mkdir "$spooldir/domains/" . $domain, 0700)
+ or die "Can't create $spooldir/domains/" . $domain .": $!";
+
+ ( open(QMAILDEFAULT,">$spooldir/domains/" . $domain . "/.qmail-default")
+ and flock(QMAILDEFAULT,LOCK_EX|LOCK_NB)
+ ) or die "Can't open $spooldir/domains/" . $domain . "/.qmail-default: $!";
+
+ ( open(VPASSWD,">$spooldir/domains/" . $domain . "/vpasswd")
+ and flock(VPASSWD,LOCK_EX|LOCK_NB)
+ ) or die "Can't open $spooldir/domains/" . $domain . "/vpasswd: $!";
+
+ my ($svc_acct);
+
+ if ($svc_domain->getfield('catchall')) {
+ $svc_acct = qsearchs('svc_acct', {'svcnum' => $svc_domain->catchall});
+ die "Cannot find catchall account for domain $domain\n" unless $svc_acct;
+
+ my $username = $svc_acct->username;
+ push @sendmail, "\@$domain\t$username\n";
+ print VIRTUALDOMAINS "$domain:$username-$domain\n",
+ ".$domain:$username-$domain\n",
+ ;
+
+ ###
+ # FORMAT OF THE .QMAIL-DEFAULT FILE HERE
+ print QMAILDEFAULT "| $vpopdir/bin/vdelivermail \"\" " . $svc_acct->email . "\n"
+ if $vpopmailmachines[0];
+
+ }else{
+ ###
+ # FORMAT OF THE .QMAIL-DEFAULT FILE HERE
+ print QMAILDEFAULT "| $vpopdir/bin/vdelivermail \"\" bounce-no-mailbox\n"
+ if $vpopmailmachines[0];
+ }
+
+ print VPOPVIRTUALDOMAINS "$domain:$domain\n";
+
+ foreach $svc_acct (qsearch('svc_acct', {'domsvc' => $svc_domain->svcnum})) {
+ my($password)=$svc_acct->getfield('_password');
+ my($cpassword,$rpassword);
+ #if ( ( length($password) <= 8 )
+ if ( ( length($password) <= 12 )
+ && ( $password ne '*' )
+ && ( $password ne '!!' )
+ && ( $password ne '' )
+ ) {
+ $cpassword=crypt($password,
+ $saltset[int(rand(64))].$saltset[int(rand(64))]
+ );
+ $rpassword=$password;
+ } else {
+ $cpassword=$password;
+ $rpassword='UNIX';
+ }
+
+ my $username;
+
+ if ($mydomain && ($mydomain eq $svc_domain->domain)) {
+ $username=$svc_acct->username;
+ } elsif ($userpolicy =~ /^prepend domsvc$/) {
+ $username=$svc_acct->domsvc . $svc_acct->username;
+ } elsif ($userpolicy =~ /^append domsvc$/) {
+ $username=$svc_acct->username . $svc_acct->domsvc;
+ } elsif ($userpolicy =~ /^append domain$/) {
+ $username=$svc_acct->username . $svc_domain->domain;
+ } elsif ($userpolicy =~ /^append domain$/) {
+ $username=$svc_acct->username . $svc_domain->domain;
+ } elsif ($userpolicy =~ /^append \@domain$/) {
+ $username=$svc_acct->username . '@'. $svc_domain->domain;
+ } else {
+ die "Unknown policy in username_policy\n";
+ }
+
+ if ($svc_acct->dir ne '/dev/null' || $svc_acct->slipip ne '') {
+ if ($usernames{$username}++) {
+ die "Duplicate username detected: $username\n";
+ }
+ }
+
+ if ( $svc_acct->uid =~ /^(\d+)$/ ) {
+
+ die "Non-root user ". $svc_acct->username. " has 0 UID!"
+ if $svc_acct->uid == 0 && $svc_acct->username ne 'root';
+
+ if ( $svc_acct->dir ne "/dev/null") {
+
+ ###
+ # FORMAT OF FreeBSD MASTER PASSWD FILE HERE
+ print MASTER join(":",
+ $username, # User name
+ $cpassword, # Encrypted password
+ $svc_acct->uid, # User ID
+ $svc_acct->gid, # Group ID
+ "", # Login Class
+ "0", # Password Change Time
+ "0", # Password Expiration Time
+ $svc_acct->finger, # Users name
+ $svc_acct->dir, # Users home directory
+ $svc_acct->shell, # shell
+ ), "\n" ;
+
+
+ ###
+ # FORMAT OF THE PASSWD FILE HERE
+ print PASSWD join(":",
+ $username,
+ 'x', # "##". $username,
+ $svc_acct->uid,
+ $svc_acct->gid,
+ $svc_acct->finger,
+ $svc_acct->dir,
+ $svc_acct->shell,
+ ), "\n";
+
+ ###
+ # FORMAT OF THE SHADOW FILE HERE
+ print SHADOW join(":",
+ $username,
+ $cpassword,
+ '',
+ '',
+ '',
+ '',
+ '',
+ '',
+ '',
+ ), "\n";
+ }
+ }
+
+ ###
+ # FORMAT OF THE VPASSWD FILE HERE
+ print VPASSWD join(":",
+ $svc_acct->username,
+ $cpassword,
+ '1',
+ '0',
+ $svc_acct->username,
+ "$vpopdir/domains/" . $svc_domain->domain ."/" . $svc_acct->username,
+ 'NOQUOTA',
+ ), "\n";
+
+
+ if ( $svc_acct->slipip ne '' ) {
+
+ ###
+ # FORMAT OF THE ACP_* FILES HERE
+ print ACP_PASSWD join(":",
+ $username,
+ $cpassword,
+ "0",
+ "0",
+ "",
+ "",
+ "",
+ ), "\n";
+
+ my($ip)=$svc_acct->slipip;
+
+ unless ( $ip eq '0.0.0.0' || $svc_acct->slipip eq '0e0' ) {
+ print ACP_DIALUP $username, "\t*\t", $svc_acct->slipip, "\n";
+ }
+
+ my %radreply = $svc_acct->radius_reply;
+ my %radcheck = $svc_acct->radius_check;
+
+ my $radcheck = join ", ", map { qq($_ = "$radcheck{$_}") } keys %radcheck;
+ $radcheck .= ", " if $radcheck;
+
+ ###
+ # FORMAT OF THE USERS FILE HERE
+ print USERS
+ $username,
+ qq(\t${textradiusprepend}),
+ $radcheck,
+# qq(Password = "$rpassword"\n\t),
+ join ",\n\t", map { qq($_ = "$radreply{$_}") } keys %radreply;
+
+ #if ( $ip && $ip ne '0e0' ) {
+ # #print USERS qq(,\n\tFramed-Address = "$ip"\n\n);
+ # print USERS qq(,\n\tFramed-IP-Address = "$ip"\n\n);
+ #} else {
+ print USERS qq(\n\n);
+ #}
+
+ }
+
+ ###
+ # vpopmail directory structure creation
+
+ (mkdir "$spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username, 0700)
+ or die "Can't create $spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . ": $!";
+ (mkdir "$spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . "/Maildir", 0700)
+ or die "Can't create $spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . " /Maildir: $!";
+ (mkdir "$spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . "/Maildir/cur", 0700)
+ or die "Can't create $spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . " /Maildir/cur: $!";
+ (mkdir "$spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . "/Maildir/new", 0700)
+ or die "Can't create $spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . " /Maildir/new: $!";
+ (mkdir "$spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . "/Maildir/tmp", 0700)
+ or die "Can't create $spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . " /Maildir/tmp: $!";
+
+ ( open(DOTQMAIL,">$spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . "/.qmail")
+ and flock(DOTQMAIL,LOCK_EX|LOCK_NB)
+ ) or die "Can't open $spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . "/.qmail: $!";
+
+ my($svc_forward);
+ foreach $svc_forward (qsearch('svc_forward', {'srcsvc' => $svc_acct->svcnum})) {
+ my($destination);
+ if ($svc_forward->dstsvc) {
+ my $dst_acct = qsearchs('svc_acct', {'svcnum' => $svc_forward->dstsvc});
+ my $dst_domain = qsearchs('svc_domain', {'svcnum' => $dst_acct->domsvc});
+ $destination = $dst_acct->username . '@' . $dst_domain->domain;
+
+ if ($dst_domain->domain eq $mydomain) {
+ print VIRTUSERTABLE $svc_acct->username . "@" . $svc_domain->domain .
+ "\t" . $dst_acct->username . "\n";
+ print RECIPIENTMAP $svc_acct->username . "@" . $svc_domain->domain .
+ ":$destination\n";
+ }
+ } else {
+ $destination = $svc_forward->dst;
+ }
+
+ ###
+ # FORMAT OF .QMAIL FILES HERE
+ print DOTQMAIL "$destination\n";
+ }
+
+ flock(DOTQMAIL,LOCK_UN);
+ close DOTQMAIL;
+
+ }
+
+ flock(VPASSWD,LOCK_UN);
+ flock(QMAILDEFAULT,LOCK_UN);
+ close VPASSWD;
+ close QMAILDEFAULT;
+
+}
+
+###
+# FORMAT OF THE ASSIGN/USERS FILE FINAL LINE HERE
+print ASSIGN ".\n";
+
+print VIRTUSERTABLE @sendmail;
+
+flock(MASTER,LOCK_UN);
+flock(PASSWD,LOCK_UN);
+flock(SHADOW,LOCK_UN);
+flock(ACP_DIALUP,LOCK_UN);
+flock(ACP_PASSWD,LOCK_UN);
+flock(USERS,LOCK_UN);
+flock(ASSIGN,LOCK_UN);
+flock(SENDMAIL_CW,LOCK_UN);
+flock(VIRTUSERTABLE,LOCK_UN);
+flock(RCPTHOSTS,LOCK_UN);
+flock(VPOPRCPTHOSTS,LOCK_UN);
+flock(RECIPIENTMAP,LOCK_UN);
+flock(VPOPVIRTUALDOMAINS,LOCK_UN);
+
+close MASTER;
+close PASSWD;
+close SHADOW;
+close ACP_DIALUP;
+close ACP_PASSWD;
+close USERS;
+close ASSIGN;
+close SENDMAIL_CW;
+close VIRTUSERTABLE;
+close RCPTHOSTS;
+close VPOPRCPTHOSTS;
+close RECIPIENTMAP;
+close VPOPVIRTUALDOMAINS;
+
+###
+# export stuff
+#
+
+my($ashellmachine);
+foreach $ashellmachine (@shellmachines) {
+ my $scp = new Net::SCP;
+ $scp->scp("$spooldir/passwd","root\@$ashellmachine:/etc/passwd.new")
+ or die "scp error: ". $scp->{errstr};
+ $scp->scp("$spooldir/shadow","root\@$ashellmachine:/etc/shadow.new")
+ or die "scp error: ". $scp->{errstr};
+ ssh("root\@$ashellmachine",
+ "( ".
+ "mv /etc/passwd.new /etc/passwd; ".
+ "mv /etc/shadow.new /etc/shadow; ".
+ " )"
+ )
+ == 0 or die "ssh error: $!";
+}
+
+my($bsdshellmachine);
+foreach $bsdshellmachine (@bsdshellmachines) {
+ my $scp = new Net::SCP;
+ $scp->scp("$spooldir/passwd","root\@$bsdshellmachine:/etc/passwd.new")
+ or die "scp error: ". $scp->{errstr};
+ $scp->scp("$spooldir/master.passwd","root\@$bsdshellmachine:/etc/master.passwd.new")
+ or die "scp error: ". $scp->{errstr};
+ ssh("root\@$bsdshellmachine",
+ "( ".
+ "mv /etc/passwd.new /etc/passwd; ".
+ #"mv /etc/master.passwd.new /etc/master.passwd; ".
+ "pwd_mkdb /etc/master.passwd.new; ".
+ " )"
+ )
+ == 0 or die "ssh error: $!";
+}
+
+my($nismachine);
+foreach $nismachine (@nismachines) {
+ my $scp = new Net::SCP;
+ $scp->scp("$spooldir/passwd","root\@$nismachine:/etc/global/passwd")
+ or die "scp error: ". $scp->{errstr};
+ $scp->scp("$spooldir/shadow","root\@$nismachine:/etc/global/shadow")
+ or die "scp error: ". $scp->{errstr};
+ ssh("root\@$nismachine",
+ "( ".
+ "cd /var/yp; make; ".
+ " )"
+ )
+ == 0 or die "ssh error: $!";
+}
+
+my($erpcdmachine);
+foreach $erpcdmachine (@erpcdmachines) {
+ my $scp = new Net::SCP;
+ $scp->scp("$spooldir/acp_passwd","root\@$erpcdmachine:/usr/annex/acp_passwd")
+ or die "scp error: ". $scp->{errstr};
+ $scp->scp("$spooldir/acp_dialup","root\@$erpcdmachine:/usr/annex/acp_dialup")
+ or die "scp error: ". $scp->{errstr};
+ ssh("root\@$erpcdmachine",
+ "( ".
+ "kill -USR1 \`cat /usr/annex/erpcd.pid\'".
+ " )"
+ )
+ == 0 or die "ssh error: $!";
+}
+
+my($radiusmachine);
+foreach $radiusmachine (@radiusmachines) {
+ my $scp = new Net::SCP;
+ $scp->scp("$spooldir/users","root\@$radiusmachine:/etc/raddb/users")
+ or die "scp error: ". $scp->{errstr};
+ ssh("root\@$radiusmachine",
+ "( ".
+ "builddbm".
+ " )"
+ )
+ == 0 or die "ssh error: $!";
+}
+
+#my @args = ("/bin/tar", "c", "--force-local", "-C", "$spooldir", "-f", "$spooldir/vpoptarball", "domains");
+
+#system {$args[0]} @args;
+
+my($vpopmailmachine);
+foreach $vpopmailmachine (@vpopmailmachines) {
+ my ($machine, $vpopdir, $vpopuid, $vpopgid) = split (/\s+/, $vpopmailmachine);
+ my $scp = new Net::SCP;
+# $scp->scp("$spooldir/vpoptarball","root\@$machine:vpoptarball")
+# or die "scp error: ". $scp->{errstr};
+# ssh("root\@$machine",
+# "( ".
+# "rm -rf domains; ".
+# "tar xf vpoptarball; ".
+# "chown -R $vpopuid:$vpopgid domains; ".
+# "tar cf vpoptarball domains; ".
+# "cd $vpopdir; ".
+# "tar xf ~/vpoptarball; ".
+# " )"
+# )
+# == 0 or die "ssh error: $!";
+
+ chdir $spooldir;
+ my @args = ("$rsync", "-rlpt", "-e", "$ssh", "domains/", "vpopmail\@$machine:$vpopdir/domains/");
+
+ system {$args[0]} @args;
+
+ $scp->scp("$spooldir/assign","root\@$machine:/var/qmail/users/assign")
+ or die "scp error: ". $scp->{errstr};
+ $scp->scp("$spooldir/vpopvirtualdomains","root\@$machine:/var/qmail/control/virtualdomains")
+ or die "scp error: ". $scp->{errstr};
+ $scp->scp("$spooldir/vpoprcpthosts","root\@$machine:/var/qmail/control/rcpthosts")
+ or die "scp error: ". $scp->{errstr};
+
+ ssh("root\@$machine",
+ "( ".
+ $vpopmailrestart .
+ " )"
+ )
+ == 0 or die "ssh error: $!";
+
+
+}
+
+my($sendmailmachine);
+foreach $sendmailmachine (@sendmailmachines) {
+ my $scp = new Net::SCP;
+ $scp->scp("$spooldir/sendmail.cw","root\@$sendmailmachine:$sendmailconfigpath/sendmail.cw.new")
+ or die "scp error: ". $scp->{errstr};
+ $scp->scp("$spooldir/virtusertable","root\@$sendmailmachine:$sendmailconfigpath/virtusertable.new")
+ or die "scp error: ". $scp->{errstr};
+ ssh("root\@$sendmailmachine",
+ "( ".
+ "mv $sendmailconfigpath/sendmail.cw.new $sendmailconfigpath/sendmail.cw; ".
+ "mv $sendmailconfigpath/virtusertable.new $sendmailconfigpath/virtusertable; ".
+ $sendmailrestart.
+ " )"
+ )
+ == 0 or die "ssh error: $!";
+}
+
+my($qmailmachine);
+foreach $qmailmachine (@qmailmachines) {
+ my $scp = new Net::SCP;
+ $scp->scp("$spooldir/recipientmap","root\@$qmailmachine:/var/qmail/control/recipientmap")
+ or die "scp error: ". $scp->{errstr};
+ $scp->scp("$spooldir/virtualdomains","root\@$qmailmachine:/var/qmail/control/virtualdomains")
+ or die "scp error: ". $scp->{errstr};
+ $scp->scp("$spooldir/rcpthosts","root\@$qmailmachine:/var/qmail/control/rcpthosts")
+ or die "scp error: ". $scp->{errstr};
+ #ssh("root\@$qmailmachine","/etc/init.d/qmail restart")
+ # == 0 or die "ssh error: $!";
+}
+
+unlink $spoollock;
+flock(EXPORT,LOCK_UN);
+close EXPORT;
+
+#
+
+sub usage {
+ die "Usage:\n\n svc_acct.export user\n";
+}
+
diff --git a/bin/svc_acct.import b/bin/svc_acct.import
new file mode 100755
index 0000000..eb94e1c
--- /dev/null
+++ b/bin/svc_acct.import
@@ -0,0 +1,238 @@
+#!/usr/bin/perl -Tw
+# $Id: svc_acct.import,v 1.17 2001-08-19 10:25:44 ivan Exp $
+
+use strict;
+use vars qw(%part_svc);
+use Date::Parse;
+use Term::Query qw(query);
+use Net::SCP qw(iscp);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch);
+use FS::svc_acct;
+use FS::part_svc;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+push @FS::svc_acct::shells, qw(/bin/sync /sbin/shuddown /bin/halt); #others?
+
+my($spooldir)="/usr/local/etc/freeside/export.". datasrc;
+
+$FS::svc_acct::nossh_hack = 1;
+
+###
+
+%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+
+die "No services with svcdb svc_acct!\n" unless %part_svc;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Most accounts probably have entries in passwd and users (with Port-Limit
+nonexistant or 1).
+END
+my($ppp_svcpart)=&getpart;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Some accounts have entries in passwd and users, but with Port-Limit 2 (or
+more).
+END
+my($isdn_svcpart)=&getpart;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Some accounts might have entries in users only (Port-Limit 1)
+END
+my($oppp_svcpart)=&getpart;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Some accounts might have entries in users only (Port-Limit >= 2)
+END
+my($oisdn_svcpart)=&getpart;
+
+print "\n\n", &menu_svc, "\n", <<END;
+POP mail accounts have entries in passwd only, and have a particular shell.
+END
+my($pop_shell)=&getvalue("Enter that shell:");
+my($popmail_svcpart)=&getpart;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Everything else in passwd is a shell account.
+END
+my($shell_svcpart)=&getpart;
+
+print "\n\n", <<END;
+Enter the location and name of your _user_ passwd file, for example
+"mail.isp.com:/etc/passwd" or "nis.isp.com:/etc/global/passwd"
+END
+my($loc_passwd)=&getvalue(":");
+iscp("root\@$loc_passwd", "$spooldir/passwd.import");
+
+print "\n\n", <<END;
+Enter the location and name of your _user_ shadow file, for example
+"mail.isp.com:/etc/shadow" or "bsd.isp.com:/etc/master.passwd"
+END
+my($loc_shadow)=&getvalue(":");
+iscp("root\@$loc_shadow", "$spooldir/shadow.import");
+
+print "\n\n", <<END;
+Enter the location and name of your radius "users" file, for example
+"radius.isp.com:/etc/raddb/users"
+END
+my($loc_users)=&getvalue(":");
+iscp("root\@$loc_users", "$spooldir/users.import");
+
+sub menu_svc {
+ ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
+}
+sub getpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_svc ];
+ $^W=1;
+ $return;
+}
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
+}
+
+print "\n\n";
+
+###
+
+open(PASSWD,"<$spooldir/passwd.import");
+open(SHADOW,"<$spooldir/shadow.import");
+open(USERS,"<$spooldir/users.import");
+
+my(%upassword,%ip,%allparam);
+my(%param,$username);
+while (<USERS>) {
+ chop;
+ next if /^\s*$/;
+ next if /^\s*#/;
+ if ( /^\S/ ) {
+ /^(\w+)\s+(Auth-Type\s+=\s+Local,\s+)?Password\s+=\s+"([^"]+)"(,\s+Expiration\s+=\s+"([^"]*")\s*)?$/
+ or die "1Unexpected line in users.import: $_";
+ my($password,$expiration);
+ ($username,$password,$expiration)=(lc($1),$3,$5);
+ $password = '' if $password eq 'UNIX';
+ $upassword{$username}=$password;
+ undef %param;
+ } else {
+ die "2Unexpected line in users.import: $_";
+ }
+ while (<USERS>) {
+ chop;
+ if ( /^\s*$/ ) {
+ if ( defined $param{'radius_Framed_IP_Address'} ) {
+ $ip{$username} = $param{'radius_Framed_IP_Address'};
+ delete $param{'radius_Framed_IP_Address'};
+ } else {
+ $ip{$username} = '0e0';
+ }
+ $allparam{$username}={ %param };
+ last;
+ } elsif ( /^\s+([\w\-]+)\s=\s"?([\w\.\-\s]+)"?,?\s*$/ ) {
+ my($attribute,$value)=($1,$2);
+ $attribute =~ s/\-/_/g;
+ $param{'radius_'.$attribute}=$value;
+ } else {
+ die "3Unexpected line in users.import: $_";
+ }
+ }
+}
+#? incase there isn't a terminating blank line ?
+if ( defined $param{'radius_Framed_IP_Address'} ) {
+ $ip{$username} = $param{'radius_Framed_IP_Address'};
+ delete $param{'radius_Framed_IP_Address'};
+} else {
+ $ip{$username} = '0e0';
+}
+$allparam{$username}={ %param };
+
+my(%password);
+while (<SHADOW>) {
+ chop;
+ my($username,$password)=split(/:/);
+ #$password =~ s/^\!$/\*/;
+ #$password =~ s/\!+/\*SUSPENDED\* /;
+ $password{$username}=$password;
+}
+
+while (<PASSWD>) {
+ chop;
+ my($username,$x,$uid,$gid,$finger,$dir,$shell)=split(/:/);
+ my($password)=$upassword{$username} || $password{$username};
+
+ my($maxb)=${$allparam{$username}}{'radius_Port_Limit'};
+ my($svcpart);
+ if ( exists $upassword{$username} ) {
+ if ( $maxb >= 2 ) {
+ $svcpart = $isdn_svcpart
+ } elsif ( ! $maxb || $maxb == 1 ) {
+ $svcpart = $ppp_svcpart
+ } else {
+ die "Illegal Port-Limit in users ($username)!\n";
+ }
+ } elsif ( $shell eq $pop_shell ) {
+ $svcpart = $popmail_svcpart;
+ } else {
+ $svcpart = $shell_svcpart;
+ }
+
+ my($svc_acct) = new FS::svc_acct ({
+ 'svcpart' => $svcpart,
+ 'username' => $username,
+ '_password' => $password,
+ 'uid' => $uid,
+ 'gid' => $gid,
+ 'finger' => $finger,
+ 'dir' => $dir,
+ 'shell' => $shell,
+ 'slipip' => $ip{$username},
+ %{$allparam{$username}},
+ });
+ my($error);
+ $error=$svc_acct->insert;
+ die $error if $error;
+
+ delete $allparam{$username};
+ delete $upassword{$username};
+}
+
+#my($username);
+foreach $username ( keys %upassword ) {
+ my($password)=$upassword{$username};
+
+ my($maxb)=${$allparam{$username}}{'radius_Port_Limit'} || 0;
+ my($svcpart);
+ if ( $maxb == 2 ) {
+ $svcpart = $oisdn_svcpart
+ } elsif ( ! $maxb || $maxb == 1 ) {
+ $svcpart = $oppp_svcpart
+ } else {
+ die "Illegal Port-Limit in users!\n";
+ }
+
+ my($svc_acct) = new FS::svc_acct ({
+ 'svcpart' => $svcpart,
+ 'username' => $username,
+ '_password' => $password,
+ 'slipip' => $ip{$username},
+ %{$allparam{$username}},
+ });
+ my($error);
+ $error=$svc_acct->insert;
+ die $error, if $error;
+
+ delete $allparam{$username};
+ delete $upassword{$username};
+}
+
+#
+
+sub usage {
+ die "Usage:\n\n svc_acct.import user\n";
+}
+
diff --git a/bin/svc_domain.erase b/bin/svc_domain.erase
new file mode 100755
index 0000000..c023661
--- /dev/null
+++ b/bin/svc_domain.erase
@@ -0,0 +1,17 @@
+#!/usr/bin/perl -w
+#
+# $Id: svc_domain.erase,v 1.1 2002-04-20 11:57:35 ivan Exp $
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+
+use FS::domain_record;
+use FS::svc_domain;
+
+adminsuidsetup(shift @ARGV) or die "Usage: svc_domain.erase user\n";
+
+foreach my $record ( qsearch('domain_record',{}), qsearch('svc_domain', {} ) ) {
+ my $error = $record->delete;
+ die $error if $error;
+}
diff --git a/bin/sysvshell.export b/bin/sysvshell.export
new file mode 100755
index 0000000..c13912c
--- /dev/null
+++ b/bin/sysvshell.export
@@ -0,0 +1,112 @@
+#!/usr/bin/perl -w
+
+# sysvshell export
+
+use strict;
+use File::Rsync;
+use Net::SSH qw(ssh);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch qsearchs);
+use FS::part_export;
+use FS::cust_svc;
+use FS::svc_acct;
+
+my @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc;
+#my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/shell";
+
+my @sysv_exports = qsearch('part_export', { 'exporttype' => 'sysvshell' } );
+
+my $rsync = File::Rsync->new({
+ rsh => 'ssh',
+# dry_run => 1,
+});
+
+foreach my $export ( @sysv_exports ) {
+ my $machine = $export->machine;
+ my $prefix = "$spooldir/$machine";
+ mkdir $prefix, 0700 unless -d $prefix;
+
+ #LOCKING!!!
+
+ ( open(SHADOW,">$prefix/shadow")
+ #!!! and flock(SHADOW,LOCK_EX|LOCK_NB)
+ ) or die "Can't open $prefix/shadow: $!";
+ ( open(PASSWD,">$prefix/passwd")
+ #!!! and flock(PASSWD,LOCK_EX|LOCK_NB)
+ ) or die "Can't open $prefix/passwd: $!";
+
+ chmod 0644, "$prefix/passwd";
+ chmod 0600, "$prefix/shadow";
+
+ my @svc_acct = $export->svc_x;
+
+ next unless @svc_acct;
+
+ foreach my $svc_acct ( sort { $a->uid <=> $b->uid } @svc_acct ) {
+
+ my $password = $svc_acct->_password;
+ my $cpassword;
+ #if ( ( length($password) <= 8 )
+ if ( ( length($password) <= 12 )
+ && ( $password ne '*' )
+ && ( $password ne '!!' )
+ && ( $password ne '' )
+ ) {
+ $cpassword=crypt($password,
+ $saltset[int(rand(64))].$saltset[int(rand(64))]
+ );
+ # MD5 !!!!
+ } else {
+ $cpassword=$password;
+ }
+
+ ###
+ # FORMAT OF THE PASSWD FILE HERE
+ print PASSWD join(":",
+ $svc_acct->username,
+ 'x', # "##". $username,
+ $svc_acct->uid,
+ $svc_acct->gid,
+ $svc_acct->finger,
+ $svc_acct->dir,
+ $svc_acct->shell,
+ ), "\n";
+
+ ###
+ # FORMAT OF THE SHADOW FILE HERE
+ print SHADOW join(":",
+ $svc_acct->username,
+ $cpassword,
+ '',
+ '',
+ '',
+ '',
+ '',
+ '',
+ '',
+ ), "\n";
+
+ }
+
+ #!!! flock(SHADOW,LOCK_UN);
+ #!!! flock(PASSWD,LOCK_UN);
+ close SHADOW;
+ close PASSWD;
+
+ $rsync->exec( {
+ src => "$prefix/shadow",
+ dest => "root\@$machine:/etc/shadow"
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+
+ $rsync->exec( {
+ src => "$prefix/passwd",
+ dest => "root\@$machine:/etc/passwd"
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+
+ # UNLOCK!!
+}