diff options
Diffstat (limited to 'bin')
49 files changed, 5039 insertions, 0 deletions
diff --git a/bin/add-history-records.pl b/bin/add-history-records.pl new file mode 100755 index 000000000..fbf9d09d9 --- /dev/null +++ b/bin/add-history-records.pl @@ -0,0 +1,139 @@ +#!/usr/bin/perl + +die "This is broken. Don't use it!\n"; + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearchs qsearch); + +use Data::Dumper; + +my @tables = qw(svc_acct svc_broadband svc_domain svc_external svc_forward svc_www cust_svc domain_record); +#my @tables = qw(svc_www); + +my $user = shift or die &usage; +my $dbh = adminsuidsetup($user); + +my $dbdef = FS::Record::dbdef; + +foreach my $table (@tables) { + + my $h_table = 'h_' . $table; + my $cnt = 0; + my $t_cnt = 0; + + eval "use FS::${table}"; + die $@ if $@; + eval "use FS::${h_table}"; + die $@ if $@; + + print "Adding history records for ${table}...\n"; + + my $dbdef_table = $dbdef->table($table); + my $pkey = $dbdef_table->primary_key; + + foreach my $rec (qsearch($table, {})) { + + #my $h_rec = qsearchs( + # $h_table, + # { $pkey => $rec->getfield($pkey) }, + # eval "FS::${h_table}->sql_h_searchs(time)", + #); + + my $h_rec = qsearchs( + $h_table, + { $pkey => $rec->getfield($pkey) }, + "DISTINCT ON ( $pkey ) *", + "AND history_action = 'insert' ORDER BY $pkey ASC, history_date DESC", + '', + 'AS maintable', + ); + + unless ($h_rec) { + my $h_insert_rec = $rec->_h_statement('insert', 1); + #print $h_insert_rec . "\n"; + $dbh->do($h_insert_rec); + die $dbh->errstr if $dbh->err; + $dbh->commit or die $dbh->errstr; + $cnt++; + } + + + $t_cnt++; + + } + + print "History records inserted into $h_table: $cnt\n"; + print " Total records in $table: $t_cnt\n"; + + print "\n"; + +} + +foreach my $table (@tables) { + + my $h_table = 'h_' . $table; + my $cnt = 0; + + eval "use FS::${table}"; + die $@ if $@; + eval "use FS::${h_table}"; + die $@ if $@; + + print "Adding insert records for unmatched delete records on ${table}...\n"; + + my $dbdef_table = $dbdef->table($table); + my $pkey = $dbdef_table->primary_key; + + #SELECT * FROM h_svc_www + #DISTINCT ON ( $pkey ) ? + my $where = " + WHERE ${pkey} in ( + SELECT ${h_table}1.${pkey} + FROM ${h_table} as ${h_table}1 + WHERE ( + SELECT count(${h_table}2.${pkey}) + FROM ${h_table} as ${h_table}2 + WHERE ${h_table}2.${pkey} = ${h_table}1.${pkey} + AND ${h_table}2.history_action = 'delete' + ) > 0 + AND ( + SELECT count(${h_table}3.${pkey}) + FROM ${h_table} as ${h_table}3 + WHERE ${h_table}3.${pkey} = ${h_table}1.${pkey} + AND ( ${h_table}3.history_action = 'insert' + OR ${h_table}3.history_action = 'replace_new' ) + ) = 0 + GROUP BY ${h_table}1.${pkey})"; + + + my @h_recs = qsearch( + $h_table, { }, + "DISTINCT ON ( $pkey ) *", + $where, + '', + '' + ); + + foreach my $h_rec (@h_recs) { + #print "Adding insert record for deleted record with pkey='" . $h_rec->getfield($pkey) . "'...\n"; + my $class = 'FS::' . $table; + my $rec = $class->new({ $h_rec->hash }); + my $h_insert_rec = $rec->_h_statement('insert', 1); + #print $h_insert_rec . "\n"; + $dbh->do($h_insert_rec); + die $dbh->errstr if $dbh->err; + $dbh->commit or die $dbh->errstr; + $cnt++; + } + + print "History records inserted into $h_table: $cnt\n"; + +} + + + +sub usage { + die "Usage:\n add-history-records.pl user\n"; +} + diff --git a/bin/apache.export b/bin/apache.export new file mode 100755 index 000000000..47863a9d5 --- /dev/null +++ b/bin/apache.export @@ -0,0 +1,67 @@ +#!/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; + + my $restart = $export->option('restart') || 'apachectl graceful'; + + ssh("root\@$machine", $restart); + +} + +close HTTPD_CONF; + +# ----- + +sub usage { + die "Usage:\n apache.export user\n"; +} + diff --git a/bin/artera.import b/bin/artera.import new file mode 100644 index 000000000..716dddad0 --- /dev/null +++ b/bin/artera.import @@ -0,0 +1,75 @@ +#!/usr/bin/perl -w + +use strict; + +use Text::CSV_XS; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearchs); +use FS::svc_external; +use FS::svc_domain; +use FS::svc_acct; + +$FS::svc_Common::noexport_hack = 1; + +my $svcpart = 30; + +my $user = shift + or die 'Usage:\n\n artera.import user <artera_active_orders.csv'; +adminsuidsetup $user; + +## + +my $csv = new Text::CSV_XS; + +my $header = scalar(<>); + +my( $num, $linked ) = ( 0, 0 ); + +while (<>) { + my $status = $csv->parse($_) + or die $csv->error_input; + my($serial, $keycode, $name, $ordernum, $email) = $csv->fields(); + #warn join(" - ", $serial, $keycode, $name, $ordernum, $email ). "\n"; + + $email =~ /^([^@]+)\@([^@]+)$/ + or die $email; + my($username, $domain) = ( $1, $2 ); + my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ); + my $cust_svc = ''; + if ( $svc_domain ) { + my $svc_acct = qsearchs('svc_acct', { + 'username' => $username, + 'domsvc' => $svc_domain->svcnum, + } ); + $cust_svc = $svc_acct->cust_svc + if $svc_acct; + #} else { + # warn "can't find domain $domain\n"; + } + + my $exist = qsearchs('svc_external', { 'id' => $serial } ); + next if $exist; + + my $svc_external = new FS::svc_external { + 'svcpart' => $svcpart, + 'pkgnum' => ( $cust_svc ? $cust_svc->pkgnum : '' ), + 'id' => $serial, + 'title' => $keycode, + }; + #my $error = $svc_external->check; + my $error = $svc_external->insert; + if ( $cust_svc && $error =~ /^Already/ ) { + warn $error; + $svc_external->pkgnum(''); + $error = $svc_external->insert; + } + warn $error if $error; + + $num++; + $linked++ if $cust_svc; + #print "$num imported, $linked linked\n"; + +} + +print "$num imported, $linked linked\n"; + diff --git a/bin/backup-dvd b/bin/backup-dvd new file mode 100644 index 000000000..d0314b469 --- /dev/null +++ b/bin/backup-dvd @@ -0,0 +1,45 @@ +#!/bin/bash + +database="freeside" +DEVICE="/dev/hda" + +su freeside -c "pg_dump $database" >/var/backups/$database.sql + +DATE=$(date +%Y-%m-%d) + +#NOTE: These two paths must end in a / in +#order to correctly build up the other paths +#BACKUP_DIR="/backup/directory/" +BACKUP_DIR="/backup/" + #TEMP_BACKUP_FILES_DIR="/backup/temp/" + +BACKUP_FILE=$BACKUP_DIR"backup-"$DATE".tar.bz2" + #DATABASE_FILE=$TEMP_BACKUP_FILES_DIR"foo-"$DATE".sql" + + #These directories shouldn't end in a / although + #I don't think it will cause any problems if + #they do. There should be a space at the end though + #to ensure the database file gets concatenated correctly. + #SOURCE="/a/location /other/locations " $DATABASE_FILE + +#echo Removing old backup directories +rm -rf $BACKUP_DIR + #rm -rf $TEMP_BACKUP_FILES_DIR + +#echo Creating new backup directories +mkdir $BACKUP_DIR + #mkdir $TEMP_BACKUP_FILES_DIR + + #echo Creating database backup + #pg_dump -U username -f $DATABASE_FILE databaseName + +#echo Backing up $SOURCE to file $BACKUP_FILE +#tar -cvpl -f $BACKUP_FILE --anchored --exclude /backup / +tar -cjpl -f $BACKUP_FILE --anchored --exclude /backup / + + ##This is not necessary and possibly harmful for DVD+RW media + #echo Quick blanking media + #dvd+rw-format -blank /dev/hdc + +#echo Burning backup +growisofs -dvd-compat -Z $DEVICE -quiet -r -J $BACKUP_FILE diff --git a/bin/billco-upload b/bin/billco-upload new file mode 100644 index 000000000..ce4a43d5f --- /dev/null +++ b/bin/billco-upload @@ -0,0 +1,20 @@ +#!/bin/sh + +AGENTNUMS="1 2 3" + +date=`date +"%Y%m%d"` +dir="/usr/local/etc/freeside/export.DBI:Pg:dbname=freeside/cust_bill" +cd "$dir" + +for AGENTNUM in $AGENTNUMS; do + + for a in header detail; do + mv agentnum$AGENTNUM-$a.csv agentnum$AGENTNUM-$date-$a.csv + done + + zip agentnum$AGENTNUM-$date.zip agentnum$AGENTNUM-$date-header.csv agentnum$AGENTNUM-$date-detail.csv + + echo $dir/agentnum$AGENTNUM-$date.zip + +done + diff --git a/bin/bind.export b/bin/bind.export new file mode 100755 index 000000000..286e43a2d --- /dev/null +++ b/bin/bind.export @@ -0,0 +1,195 @@ +#!/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 = $export->option('reload') + || ( ($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: $!"; + + if ( -e "$prefix/named.conf.HEADER" ) { + 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: $!"; + + if ( -e "$prefix/named.conf.HEADER" ) { + 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 000000000..1cdf5672c --- /dev/null +++ b/bin/bind.import @@ -0,0 +1,234 @@ +#!/usr/bin/perl -w +# +# REQUIRED: +# -p: part number for domains +# +# -n: named.conf file (or an include file with zones you want to import), +# for example root@ns.isp.com:/var/named/named.conf +# +# OPTIONAL: +# -d: dry-run, debug: don't insert any records, just dump debugging output +# -s: import slave zones as master. useful if you need to recreate your +# primary nameserver from a secondary +# -c dir: override patch for downloading zone files (for example, when +# downloading zone files from chrooted bind) +# +# need to manually put header in +# /usr/local/etc/freeside/export.<datasrc./bind/<machine>/named.conf.HEADER +# (or, nowadays, better just to include the file freeside exports) + +use strict; + +use vars qw($domain_svcpart); + +use Getopt::Std; +use Data::Dumper; +#use BIND::Conf_Parser; +#use DNS::ZoneParse 0.81; + +use Net::SCP qw(scp 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 vars qw($opt_p $opt_n $opt_s $opt_c $opt_d); +getopts("p:n:sc:d"); + +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; + +$domain_svcpart = $opt_p; + +my $named_conf = $opt_n; + +use vars qw($named_machine $prefix); +$named_machine = (split(/:/, $named_conf))[0]; +my $pnamed_machine = $named_machine; +$pnamed_machine =~ s/^[\w\-]+\@//; +$prefix = "$spooldir/$pnamed_machine"; +mkdir $prefix unless -d $prefix; + +#iscp("$named_conf","$prefix/named.conf.import"); +scp("$named_conf","$prefix/named.conf.import"); + +## + +$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 -p partnum -n \"user\@machine:/path/to/named.conf\" [ -s ] [ -c chroot_dir ] [ -f ] user\n"; +} + +######## +BEGIN { + + package Parser; + use BIND::Conf_Parser; + use vars qw(@ISA $named_dir); + @ISA = qw(BIND::Conf_Parser); + + $named_dir = 'COULD_NOT_FIND_NAMED_DIRECTORY_TRY_SETTING_-C_OPTION'; + sub handle_option { + my($self, $option, $argument) = @_; + return unless $option eq "directory"; + $named_dir = $argument; + #warn "found named dir: $named_dir\n"; + } + + 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 + 0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa + 0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.int + )); + + use FS::Record qw(qsearchs); + use FS::svc_domain; + + my $domain = + qsearchs('svc_domain', { 'domain' => $name } ) + || new FS::svc_domain( { + svcpart => $main::domain_svcpart, + domain => $name, + action => 'N', + } ); + unless ( $domain->svcnum ) { + my $error = $domain->insert; + die $error if $error; + } + + if ( $type eq 'slave' && !$main::opt_s ) { + + if ( $main::opt_d ) { + + use Data::Dumper; + print "$name: ". Dumper($options); + + } else { + + 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' || ( $type eq 'slave' && $main::opt_s ) ) { + + my $file = $options->{file}; + + use File::Basename; + my $basefile = basename($file); + my $sourcefile = $file; + if ( $main::opt_c ) { + $sourcefile = "$main::opt_c/$sourcefile" if $main::opt_c; + } else { + $sourcefile = "$named_dir/$sourcefile" unless $file =~ /^\//; + } + + use Net::SCP qw(iscp scp); + #iscp("$main::named_machine:$sourcefile", + # "$main::prefix/$basefile.import"); + scp("$main::named_machine:$sourcefile", + "$main::prefix/$basefile.import"); + + use DNS::ZoneParse 0.84; + my $zone = DNS::ZoneParse->new("$main::prefix/$basefile.import"); + + my $dump = $zone->dump; + + if ( $main::opt_d ) { + + use Data::Dumper; + print "$name: ". Dumper($dump); + + } else { + + foreach my $rectype ( keys %$dump ) { + if ( $rectype =~ /^SOA$/i ) { + my $rec = $dump->{$rectype}; + $rec->{email} =~ s/\@/\./; + 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}; + + my $datasub; + if ( $rectype =~ /^MX$/i ) { + $datasub = sub { $_[0]->{priority}. ' '. $_[0]->{host}; }; + } elsif ( $rectype =~ /^TXT$/i ) { + $datasub = sub { $_[0]->{text}; }; + } else { + $datasub = sub { $_[0]->{host}; }; + } + + foreach my $rec ( @{ $dump->{$rectype} } ) { + my $domain_record = new FS::domain_record( { + 'svcnum' => $domain->svcnum, + 'reczone' => $rec->{name}, + 'recaf' => $rec->{class} || 'IN', + 'rectype' => $rectype, + 'recdata' => &{$datasub}($rec), + } ); + my $error = $domain_record->insert; + if ( $error ) { + warn "$error inserting ". + $rec->{name}. ' . '. $domain->domain. "\n"; + warn Dumper($rec); + #system('cat',"$main::prefix/$basefile.import"); + die; + } + } + } + } + + } + + #} else { + # die "unrecognized type $type\n"; + } + + } + +} +######### + diff --git a/bin/bsdshell.export b/bin/bsdshell.export new file mode 100755 index 000000000..6e0d1037e --- /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 000000000..11bde0ce3 --- /dev/null +++ b/bin/create-fetchmailrc @@ -0,0 +1,47 @@ +#!/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"; + +exit unless $ARGV[0]; + +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 000000000..39248bf3f --- /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 000000000..fea02c8c5 --- /dev/null +++ b/bin/dbdef-create @@ -0,0 +1,24 @@ +#!/usr/bin/perl -Tw + +use strict; +use DBI; +use DBIx::DBSchema 0.26; +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 000000000..dc4abd751 --- /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.26; +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 000000000..fe12931fc --- /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 000000000..d5fd703f6 --- /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/freeside.import b/bin/freeside.import new file mode 100644 index 000000000..fdfcc083e --- /dev/null +++ b/bin/freeside.import @@ -0,0 +1,146 @@ +#!/usr/bin/perl -w + +use strict; +use DBI; + +my $s_datasrc = 'DBI:mysql:host=ns1.enetonline.net;port=3307;user=ivan;dbname=freeside'; +my $s_dbuser = 'ivan'; +my $s_dbpass = ''; + +my $d_datasrc = 'DBI:Pg:dbname=freeside'; +my $d_dbuser = 'freeside'; +my $d_dbpass = ''; + +#my @tables = qw( +#addr_block +#agent +#agent_type +#cust_bill +#cust_bill_event +#cust_bill_pay +#cust_bill_pkg +#cust_bill_pkg_detail +#cust_credit +#cust_credit_bill +#cust_credit_refund +#cust_main +#cust_main_county +#cust_main_invoice +#cust_pay +#cust_pay_batch +#cust_pkg +#cust_refund +#cust_svc +#cust_tax_exempt +#domain_record +#export_svc +#h_addr_block +#h_agent +#h_agent_type +#h_cust_bill +#h_cust_bill_event +#h_cust_bill_pay +#h_cust_bill_pkg +#h_cust_bill_pkg_detail +#h_cust_credit +#h_cust_credit_bill +#h_cust_credit_refund +#h_cust_main +#h_cust_main_county +#h_cust_main_invoice +#h_cust_pay +#h_cust_pay_batch +#h_cust_pkg +#h_cust_refund +#h_cust_svc +#h_cust_tax_exempt +#h_domain_record +#h_export_svc +#h_msgcat +#h_nas +#h_part_bill_event +#h_part_export +#h_part_export_option +#h_part_pkg +#h_part_pop_local +#h_part_referral +#h_part_svc +#h_part_svc_column +#h_part_svc_router +#h_pkg_svc +#h_port +#h_prepay_credit +#h_queue +#h_queue_arg +#h_queue_depend +#h_radius_usergroup +#h_router +#h_router_field +#h_sb_field +#h_session +#h_svc_acct +#h_svc_acct_pop +#h_svc_broadband +#h_svc_domain +#h_svc_forward +#h_svc_www +#h_type_pkgs +#msgcat +#nas +#part_bill_event +#part_export +#part_export_option +#part_pkg + +my @tables = qw( +part_pop_local +part_referral +part_router_field +part_sb_field +part_svc +part_svc_column +part_svc_router +pkg_svc +port +prepay_credit +queue +queue_arg +queue_depend +radius_usergroup +router +router_field +sb_field +session +svc_acct +svc_acct_pop +svc_broadband +svc_domain +svc_forward +svc_www +type_pkgs +); + +my $s_dbh = DBI->connect($s_datasrc, $s_dbuser, $s_dbpass) or die $DBI::errstr; +my $d_dbh = DBI->connect($d_datasrc, $d_dbuser, $d_dbpass) or die $DBI::errstr; + +foreach my $table ( @tables ) { + $d_dbh->do("delete from $table"); + + my $s_sth = $s_dbh->prepare("select * from $table"); + $s_sth->execute or die $s_sth->errstr; + + my $row; + while ( $row = $s_sth->fetchrow_arrayref ) { + my $d_sth = $d_dbh->prepare( + "insert into $table ( ". + join(', ', @{$s_sth->{NAME}} ). + ' ) VALUES ( '. + join(', ', map { '?' } @{$s_sth->{NAME}} ). + ' )' + ) or die $d_dbh->errstr; + + $d_sth->execute(@$row) or die $d_sth->errstr; + + } +} + diff --git a/bin/fs-migrate-part_svc b/bin/fs-migrate-part_svc new file mode 100755 index 000000000..b0f3ac57e --- /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 000000000..158419706 --- /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 000000000..e34b23596 --- /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 000000000..4e4769e58 --- /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 000000000..3de01374f --- /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 000000000..cb4ba7fc6 --- /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 000000000..af21c05a8 --- /dev/null +++ b/bin/generate-raddb @@ -0,0 +1,53 @@ +#!/usr/bin/perl + +# usage: generate-raddb radius-server/raddb/dictionary* >raddb.pm +# i.e.: generate-raddb ~/freeradius/freeradius-1.0.5/share/dictionary* ~/wirelessoceans/dictionary.ip3networks ~/wtxs/dictionary.mot.canopy >raddb.pm.new +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 ( sort 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 " '$_' ". ( " " x (24-length($_) ) ). "=> '$hash{$_}',\n"; +} + +print <<END; + + #NETC.NET.AU (RADIATOR?) + 'authentication_type' => 'Authentication-Type', + + #wtxs (dunno) + #'radius_operator' => 'Radius-Operator', + +); + +1; +END + diff --git a/bin/generate-table-module b/bin/generate-table-module new file mode 100755 index 000000000..fcc3f1d1f --- /dev/null +++ b/bin/generate-table-module @@ -0,0 +1,89 @@ +#!/usr/bin/perl + +use FS::Schema qw( dbdef_dist ); + +my $table = shift; + +### +# add a new FS/FS/table.pm +### + +my %ut = ( #just guesses + 'int' => 'number', + 'number' => 'float', + 'varchar' => 'text', + 'text' => 'text', +); + +my $dbdef_table = dbdef_dist->table($table) + or die "define table in Schema.pm first"; +my $primary_key = $dbdef_table->primary_key; + +open(SRC,"<eg/table_template.pm") or die $!; +-e "FS/FS/$table.pm" and die "FS/FS/$table.pm already exists!"; +open(DEST,">FS/FS/$table.pm") or die $!; + +while (my $line = <SRC>) { + + $line =~ s/table_name/$table/g; + + if ( $line =~ /^=item\s+field\s+-\s+description\s*$/ ) { + + foreach my $column ( $dbdef_table->columns ) { + print DEST "=item $column - "; + print DEST "primary key" + if $column eq $primary_key; + print DEST "\n\n"; + } + next; + + } elsif ( $line=~ /^(\s*)\$self->ut_numbern\('primary_key'\)\s*/ ) { + + print DEST "$1\$self->ut_numbern('$primary_key')\n" + if $primary_key; + next; + + } elsif ( + $line =~ /^(\s*)\|\|\s+\$self->ut_number\('validate_other_fields'\)\s*/ + ) { + + foreach my $column ( grep { $_ ne $primary_key } $dbdef_table->columns ) { + my $ut = $ut{$dbdef_table->column($column)->type}; + $ut .= 'n' if $dbdef_table->column($column)->null; + print DEST "$1|| \$self->ut_$ut('$column')\n"; + } + next; + + } + + print DEST $line; +} + +close SRC; +close DEST; + +### +# add FS/t/table.t +### + +open(TEST,">FS/t/$table.t") or die $!; +print TEST <<ENDTEST; +BEGIN { \$| = 1; print "1..1\\n" } +END {print "not ok 1\\n" unless \$loaded;} +use FS::$table; +\$loaded=1; +print "ok 1\\n"; +ENDTEST +close TEST; + +### +# add them to MANIFEST +### + +system('cvs edit FS/MANIFEST'); + +open(MANIFEST,">>FS/MANIFEST") or die $!; +print MANIFEST "FS/$table.pm\n", + "t/$table.t\n"; +close MANIFEST; + diff --git a/bin/generate-tests b/bin/generate-tests new file mode 100755 index 000000000..73fd29ecb --- /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/ispman.ldap.import b/bin/ispman.ldap.import new file mode 100755 index 000000000..7495f47f8 --- /dev/null +++ b/bin/ispman.ldap.import @@ -0,0 +1,114 @@ +#!/usr/bin/perl -w + +use strict; +use Net::LDAP::LDIF; + +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearchs); +use FS::svc_domain; +use FS::svc_acct; + +my $user = shift or die; +adminsuidsetup($user); + +$FS::svc_Common::noexport_hack = 1; +$FS::svc_domain::whois_hack = 1; + +my $domain_svcpart = 1; +my $account_svcpart = 2; +my $mailbox_svcpart = 3; +my $fedweeknet_svcpart = 4; + +#my $ldif = +# Net::LDAP::LDIF->new( "ispman-06-23-04.ldif", "r", onerror => 'undef' ); +my $ldif = + Net::LDAP::LDIF->new( "ispman-06-23-04.ldif", "r", onerror => 'warn' ); + +#my %objectclass; + +my $acct = 0; +my $imported = 0; + +my $entry; +while ( $entry = $ldif->read_entry ) { + #warn "$entry\n"; + my %attributes = map { $_ => [ $entry->get_value( $_ ) ] } $entry->attributes; + + my $objectclass = join('/', @{$attributes{'objectclass'}} ); + + next unless $objectclass eq 'posixAccount/ispmanDomainUser/radiusprofile'; + + foreach my $attr ( keys %attributes ) { + print join( " => ", substr($attr.' 'x30,0,30), @{$attributes{ $attr }} ), "\n"; + #if ( $attr eq 'objectclass' ) { + # $objectclass{ join('/', @{$attributes{$attr}} ) }++; + #} + } + print "\n"; + + $acct++; + + my $email = $attributes{'maillocaladdress'}->[0]; + $email =~ /^(\w+)\@([\w\.\-]+)$/ or die $email; + die "$1 ne ". $attributes{'ispmanuserid'}->[0]. "\n" + unless lc($1) eq $attributes{'ispmanuserid'}->[0]; + my $username = lc($1); + my $domain = lc($2); + + my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ) + || new FS::svc_domain { 'svcpart' => $domain_svcpart, + 'domain' => $domain, + 'action' => 'N', + }; + + unless ( $svc_domain->svcnum ) { + my $error = $svc_domain->insert; + if ( $error ) { + die "inserting domain: $error\n"; + } + } + + ( my $password = $attributes{'userpassword'}->[0] ) =~ s/^\{crypt\}//; + + # pick svcpart + my $svcpart = $account_svcpart; + if ( $domain eq 'fedweeknet.com' ) { + $svcpart = $fedweeknet_svcpart; + } elsif ( $attributes{'dialupaccess'}->[0] =~ /(false|no)/i ) { + $svcpart = $mailbox_svcpart; + } + + my $dir = $attributes{'homedirectory'}->[0]; + $dir =~ s/\s+//g; + $dir =~ s/\@/_/; + + my $svc_acct = new FS::svc_acct { + 'svcpart' => $svcpart, + 'username' => $username, + '_password' => $password, + 'finger' => $attributes{'cn'}->[0], + 'domsvc' => $svc_domain->svcnum, + 'shell' => $attributes{'loginshell'}->[0], + 'uid' => $attributes{'uidnumber'}->[0], + 'gid' => $attributes{'gidnumber'}->[0], + 'dir' => $dir, + 'quota' => $attributes{'mailquota'}->[0], + }; + my $error = $svc_acct->insert; + #my $error = $svc_acct->check; + + if ( $error ) { + warn "$error\n"; + } else { + $imported++; + } + +} + +print "$imported of $acct imported\n"; + +#print "\n\n"; + +#foreach ( sort { $objectclass{$b} <=> $objectclass{$a} } keys %objectclass ) { +# print "$objectclass{$_}: $_\n"; +#} diff --git a/bin/masonize b/bin/masonize new file mode 100755 index 000000000..509ef3ec8 --- /dev/null +++ b/bin/masonize @@ -0,0 +1,80 @@ +#!/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; + $newline = ''; #avoid prepending extraneous newlines + $all = join('',@file); + + $w = ''; + + $mode = 'html'; + while ( length($all) ) { + + if ( $mode eq 'html' ) { + + if ( $all =~ /^(.+?)(<%=?.*)$/s && $1 !~ /<%/s ) { + $w .= $1; + $all = $2; + next; + } elsif ( $all =~ /^<%=(.*)$/s ) { + $w .= '<%'; + $all = $1; + $mode = 'perlv'; + #die; + next; + } elsif ( $all =~ /^<%(.*)$/s ) { + $w .= $newline; $newline = "\n"; + $all = $1; + $mode = 'perlc'; + + #avoid newline prepend fix from borking indented first <% + $w =~ s/\n\s+\z/\n/; + $w .= "\n" if $w =~ /.+\z/; + + next; + } elsif ( $all !~ /<%/s ) { + $w .= $all; + last; + } else { + warn length($all); die; + } + die; + + } elsif ( $mode eq 'perlv' ) { + + if ( $all =~ /^(.*?%>)(.*)$/s ) { + $w .= $1; + $all=$2; + $mode = 'html'; + next; + } + die "unterminated <%= ??? (in $file):"; + + } elsif ( $mode eq 'perlc' ) { + + if ( $all =~ /^([^\n]*?)%>(.*)$/s ) { + $w .= "%$1\n"; + $all=$2; + $mode='html'; + next; + } + if ( $all =~ /^([^\n]*)\n(.*)$/s ) { + $w .= "%$1\n"; + $all=$2; + next; + } + + } else { die }; + + } + + system("chmod u+w $file"); + select W; $| = 1; select STDOUT; + open(W,">$file") or die "can't open $file for writing: $!"; + print W $w; + close W; +} diff --git a/bin/passwd.import b/bin/passwd.import new file mode 100755 index 000000000..8ab9e2ae3 --- /dev/null +++ b/bin/passwd.import @@ -0,0 +1,121 @@ +#!/usr/bin/perl -Tw + +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 =~ s/^NP$/\*/; + $password =~ s/^\*LK\*$/\*/; + $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/pg-readonly b/bin/pg-readonly new file mode 100644 index 000000000..ad69fbde2 --- /dev/null +++ b/bin/pg-readonly @@ -0,0 +1,24 @@ +#!/usr/bin/perl +# +# hack to update/add read-only permissions for a user on the db +# +# usage: pg-readonly freesideuser readonlyuser + +use strict; +use DBI; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(dbdef); + +my $user = shift or die &usage; +my $rouser = shift or die &usage; + +my $dbh = adminsuidsetup $user; + +foreach my $table ( dbdef->tables ) { + $dbh->do("GRANT SELECT ON $table TO $rouser"); + $dbh->commit(); + if ( my $pkey = dbdef->table($table)->primary_key ) { + $dbh->do("GRANT SELECT ON ${table}_${pkey}_seq TO $rouser"); + $dbh->commit(); + } +} diff --git a/bin/pod2x b/bin/pod2x new file mode 100755 index 000000000..46ccc7743 --- /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 000000000..adac92dd0 --- /dev/null +++ b/bin/populate-msgcat @@ -0,0 +1,135 @@ +#!/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', + }, + + 'svc_external-id' => { + 'en_US' => 'External ID', + }, + + 'svc_external-title' => { + 'en_US' => 'Title', + }, + + ); +} + +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 000000000..61380da59 --- /dev/null +++ b/bin/postfix.export @@ -0,0 +1,122 @@ +#!/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", $export->option('newaliases') || '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", $export->option('postmap') + || 'postmap hash:/etc/postfix/virtual'); + ssh("$user\@$machine", $export->option('reload') || 'postfix reload'); + +} + +# ----- + +sub usage { + die "Usage:\n postfix.export user\n"; +} + + diff --git a/bin/postfix_courierimap.import b/bin/postfix_courierimap.import new file mode 100755 index 000000000..12c138b49 --- /dev/null +++ b/bin/postfix_courierimap.import @@ -0,0 +1,137 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw(%part_svc %domain_part_svc); +#use Date::Parse; +use DBI; +use Term::Query qw(query); +use FS::UID qw(adminsuidsetup); #datasrc +use FS::Record qw(qsearch qsearchs); +use FS::svc_acct; +use FS::part_svc; +use FS::svc_domain; + +my $user = shift or die &usage; +adminsuidsetup $user; + +#push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others? + +$FS::svc_Common::noexport_hack = 1; +$FS::svc_domain::whois_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 $mailbox_svcpart = &getpart; + +%domain_part_svc = map { $_->svcpart, $_ } + qsearch('part_svc', { 'svcdb' => 'svc_domain'} ); + +die "No services with svcdb svc_domain!\n" unless %domain_part_svc; + +print "\n\n", &menu_domain_svc, "\n", <<END; +Enter part number for domains. +END +my $domain_svcpart = &getdomainpart; + +my $datasrc = &getvalue("\n\nEnter the DBI datasource:"); +my $db_user = &getvalue("\n\nEnter the database user:"); +my $db_pass = &getvalue("\n\nEnter the database password:"); + +sub menu_svc { + ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n"; +} +sub menu_domain_svc { + ( join "\n", map "$_: ".$domain_part_svc{$_}->svc, sort keys %domain_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 getdomainpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %domain_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"; + +### + +my $dbh = DBI->connect( $datasrc, $db_user, $db_pass ) + or die $DBI::errstr; + +my $sth = $dbh->prepare('SELECT username, password, crypt, name, domain FROM mailbox') + or die $dbh->errstr; +$sth->execute or die $sth->errstr; + +my $row; +while ( defined ( $row = $sth->fetchrow_arrayref ) ) { + my( $r_username, $password, $crypt, $finger, $r_domain ) = @$row; + + my( $username, $domain ); + if ( $r_username =~ /^([^@]+)\@([^@]+)$/ ) { + $username = $1; + $domain = $2; + } else { + $username = $r_username; + $domain = $r_domain; + } + my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ) + || new FS::svc_domain { + 'domain' => $domain, + 'svcpart' => $domain_svcpart, + 'action' => 'N', + }; + unless ( $svc_domain->svcnum ) { + my $error = $svc_domain->insert; + if ( $error ) { + die "can't insert domain $domain: $error\n"; + } + } + + $password = $crypt if $password eq '*CRYPTED*'; + + $finger =~ s/Outdoor Power.*$/Outdoor Power/; + + my $svc_acct = new FS::svc_acct { + 'svcpart' => $mailbox_svcpart, + 'username' => $username, + 'domsvc' => $svc_domain->svcnum, + '_password' => $password, + 'finger' => $finger, + }; + + my $error = $svc_acct->insert; + #my $error = $svc_acct->check; + if ( $error ) { + if ( $error =~ /duplicate/i ) { + warn "$r_username / $r_domain: $error"; + } else { + die "$r_username / $r_domain: $error"; + } + } + +} + +sub usage { + die "Usage:\n\n postfix_courierimap.import user\n"; +} + + diff --git a/bin/print-schema b/bin/print-schema new file mode 100755 index 000000000..886e3250b --- /dev/null +++ b/bin/print-schema @@ -0,0 +1,7 @@ +#!/usr/bin/perl + +use DBIx::DBSchema; + +$l = load DBIx::DBSchema "/usr/local/etc/freeside/dbdef.DBI:Pg:dbname=freeside"; + +print $l->pretty_print, "\n"; diff --git a/bin/rate-us.import b/bin/rate-us.import new file mode 100755 index 000000000..66ac5de94 --- /dev/null +++ b/bin/rate-us.import @@ -0,0 +1,109 @@ +#!/usr/bin/perl -w + +use strict; +#use Spreadsheet::ParseExcel; +use DBI; +use FS::UID qw(adminsuidsetup); +use FS::rate_region; +use FS::rate_prefix; +use FS::rate_region; + +my $ratenum = 1; + +my $user = shift or usage(); +adminsuidsetup $user; + +sub usage { + #die "Usage:\n\n rate.import user rates.xls worksheet_name"; + die "Usage:\n\n rate.import user"; +} + +my %rate_region; + +foreach my $file ( 'areas and rates US.xls', + 'areas and rates US2.xls', + 'areas and rates US3.xls', + ) +{ + + my $dbh = DBI->connect("DBI:Excel:file=$file") + or die "can't connect: $DBI::errstr"; + + #my $table = shift or usage(); + my $table = 'Sheet1'; + my $sth = $dbh->prepare("select * from $table") + or die "can't prepare: ". $dbh->errstr; + $sth->execute + or die "can't execute: ". $sth->errstr; + + while ( my $row = $sth->fetchrow_hashref ) { + + #print join(' - ', map $row->{$_}, qw( rate_center Code Area_Prefix Rate ) ). "\n"; + + my $regionname = $row->{'rate_center'}; + $regionname =~ s/\xA0//g; + #$regionname =~ s/\xE9/e/g; #e with accent aigu + $regionname =~ s/(^\s+|\s+$)//; + $regionname .= ', USA'; + + my $prefix = $row->{'area_prefix'}; + $prefix =~ s/\xA0//g; + $prefix =~ s/\s$//; + #my $prefixprefix = ''; + #if ( $prefix =~ /^\s*(\d+)\s*\((.*)\)\s*$/ ) { + # $prefixprefix = $1; + # $prefix = $2; + #} elsif ( $prefix =~ /^\s*\((\d{3})\)\s*(.*)$/ ) { + # $prefixprefix = $1; + # $prefix = $2; + #} + + my @rate_prefix = map { + #warn $row->{'rate_center'}. ": $prefixprefix$_\n"; + new FS::rate_prefix { + 'countrycode' => '1', # $row->{'Country'} + #'npa' => $prefixprefix.$_, + 'npa' => $_, + }; + } + split(/\s*[;,]\s*/, $prefix); + + + my $dest_detail = new FS::rate_detail { + 'ratenum' => $ratenum, + 'min_included' => 0, + 'min_charge' => + sprintf('%.2f', $row->{'rate'} ), + 'sec_granularity' => 60, + }; + + unless ( exists $rate_region{$regionname} ) { + + my $rate_region = new FS::rate_region { + 'regionname' => $regionname, + }; + + my $error = $rate_region->insert( 'rate_prefix' => \@rate_prefix, + 'dest_detail' => [ $dest_detail ], + ); + die $error if $error; + + $rate_region{$regionname} = $rate_region->regionnum; + + } else { + + foreach my $rate_prefix ( @rate_prefix ) { + $rate_prefix->regionnum($rate_region{$regionname}); + my $error = $rate_prefix->insert; + die $error if $error; + } + + #$rate_detail->dest_regionnum($rate_region{$regionname}); + #$error = $rate_detail->insert; + #die $error if $error; + + } + + } + +} diff --git a/bin/rate.import b/bin/rate.import new file mode 100755 index 000000000..fdd756d72 --- /dev/null +++ b/bin/rate.import @@ -0,0 +1,95 @@ +#!/usr/bin/perl + +use strict; +#use Spreadsheet::ParseExcel; +use DBI; +use FS::UID qw(adminsuidsetup); +use FS::rate_region; +use FS::rate_prefix; +use FS::rate_region; + +my $ratenum = 1; + +my $user = shift or usage(); +adminsuidsetup $user; + +#my $file = shift or usage(); +my $file = 'areas and rates.xls'; +my $dbh = DBI->connect("DBI:Excel:file=$file") + or die "can't connect: $DBI::errstr"; + +#my $table = shift or usage(); +my $table = 'areas_and_rates'; +my $sth = $dbh->prepare("select * from $table") + or die "can't prepare: ". $dbh->errstr; +$sth->execute + or die "can't execute: ". $sth->errstr; + +sub usage { + #die "Usage:\n\n rate.import user rates.xls worksheet_name"; + die "Usage:\n\n rate.import user"; +} + +## + +while ( my $row = $sth->fetchrow_hashref ) { + + #print join(' - ', map $row->{$_}, qw( Country Code Area_Prefix Rate ) ). "\n"; + + my $regionname = $row->{'Country'}; + $regionname =~ s/\xA0//g; + $regionname =~ s/\xE9/e/g; #e with accent aigu + $regionname =~ s/(^\s+|\s+$)//; + + #next if $regionname =~ /Sweden Telia Mobile/; + + my $rate_region = new FS::rate_region { + 'regionname' => $regionname, + }; + + my $prefix = $row->{'Area_Prefix'}; + $prefix =~ s/\xA0//g; + $prefix =~ s/\s$//; + my $prefixprefix = ''; + if ( $prefix =~ /^\s*(\d+)\s*\((.*)\)\s*$/ ) { + $prefixprefix = $1; + $prefix = $2; + } elsif ( $prefix =~ /^\s*\((\d{3})\)\s*(.*)$/ ) { + $prefixprefix = $1; + $prefix = $2; + } + + my @rate_prefix = (); + if ( $prefix =~ /\d/ ) { + + @rate_prefix = map { + #warn $row->{'Country'}. ": $prefixprefix$_\n"; + new FS::rate_prefix { + 'countrycode' => $row->{'Code'}, + 'npa' => $prefixprefix.$_, + }; + } + split(/\s*[;,]\s*/, $prefix); + + } else { + @rate_prefix = ( new FS::rate_prefix { + 'countycode' => $row->{'Code'}, + 'npa' => '', + }; + ); + } + + my $dest_detail = new FS::rate_detail { + 'ratenum' => $ratenum, + 'min_included' => 0, + 'min_charge' => + sprintf('%.2f', $row->{'Rate'} ), + 'sec_granularity' => 60, + }; + + my $error = $rate_region->insert( 'rate_prefix' => \@rate_prefix, + 'dest_detail' => [ $dest_detail ], + ); + die $error if $error; + +} diff --git a/bin/rollback b/bin/rollback new file mode 100755 index 000000000..7f83ef41a --- /dev/null +++ b/bin/rollback @@ -0,0 +1,38 @@ +#!/usr/bin/perl + +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs fields); + +use FS::svc_acct; + +#cust_pkg pkgnum 240133 241206 replace_old +#cust_svc svcnum 31102 32083 delete +#svc_acct svcnum 37162 37652 delete +my($user, $table, $pkey, $start, $end, $action) = @ARGV; + +adminsuidsetup $user or die; + +#eval "use FS::h_$table;"; +#die $@ if $@; +eval "use FS::$table;"; +die $@ if $@; + +my @history = grep { $_->historynum <= $end } qsearch("h_$table", { 'historynum' => { op=>'>=', value=>$start }, history_action => $action } ); + +my %seen; +foreach my $h (@history) { + my $error; + if ( $action eq 'replace_old' ) { + my $old = qsearchs($table, { $pkey => $h->get($pkey) } ); + unless ( $old ) { die "can't find $table $pkey ". $h->get($pkey). "\n"; } + my $new = "FS::$table"->new( { map { $_ => $h->get($_) } fields($table) } ); + $error = $new->replace($old); + } elsif ( $action eq 'delete' ) { + next if $seen{$h->get($pkey)}++; + my $new = "FS::$table"->new( { map { $_ => $h->get($_) } fields($table) } ); + $error = $new->insert; + } else { + die "unknown action $action\n"; + } + die $error if $error; +} diff --git a/bin/rt-drop-tables b/bin/rt-drop-tables new file mode 100755 index 000000000..b027542b3 --- /dev/null +++ b/bin/rt-drop-tables @@ -0,0 +1,29 @@ +#!/usr/bin/perl + +my @tables = qw( +Attachments +Queues +Links +Principals +Groups +ScripConditions +Transactions +Scrips +ACL +GroupMembers +CachedGroupMembers +Users +Tickets +ScripActions +Templates +TicketCustomFieldValues +CustomFields +CustomFieldValues +sessions +); + +foreach my $table ( @tables ) { + print "drop table $table;\n"; + print "drop sequence ${table}_id_seq;\n"; +} + diff --git a/bin/sendmail.import b/bin/sendmail.import new file mode 100644 index 000000000..ef745fc46 --- /dev/null +++ b/bin/sendmail.import @@ -0,0 +1,178 @@ +#!/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 = '295.ca'; + +use vars qw(@svcpart $forward_svcpart); +@svcpart = qw( 2 4 ); +$forward_svcpart = 7; + +use vars qw($spooldir); +$spooldir = "/usr/local/etc/freeside/export.". datasrc. "/sendmail"; +mkdir($spooldir, 0755) 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, 0755) 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, 0755) unless -d $virtusertable_prefix; +mkdir("$virtusertable_prefix/virtusertable.import", 0755) + 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 { my $svc_acct = $_; + grep { $svc_acct->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/sequences.reset b/bin/sequences.reset new file mode 100644 index 000000000..2dc1d3bb2 --- /dev/null +++ b/bin/sequences.reset @@ -0,0 +1,32 @@ +#!/usr/bin/perl + +use FS::UID qw(adminsuidsetup); +use FS::Record qw(dbdef dbh); + +my $user = shift; +adminsuidsetup $user or die; + +foreach my $table ( dbdef->tables ) { + my $primary_key = dbdef->table($table)->primary_key; + next unless $primary_key; + #my $local = dbdef->table($table)->column($primary_key)->local; + ##next unless $default =~ /nextval/; + #print "$local\n"; + + my $statement = "select setval('${table}_${primary_key}_seq', ( select max($primary_key) from $table ) )"; + + print "$statement;\n"; + next; + + my $sth = dbh->prepare($statement) or do { + warn dbh->errstr. " preparing $statement\n"; + next; + }; + $sth->execute or do { + warn dbh->errstr. " executing $statement\n"; + dbh->commit; + next; + } + +} + diff --git a/bin/shadow.reimport b/bin/shadow.reimport new file mode 100755 index 000000000..7957011eb --- /dev/null +++ b/bin/shadow.reimport @@ -0,0 +1,125 @@ +#!/usr/bin/perl -w +# +# -d: dry-run: make no changes +# -r: replace: overwrite existing passwords (otherwise only "*" passwords will +# be changed) +# -b: blowfish replace: overwrite existing passwords only if they are +# blowfish-encrypted + +use strict; +use vars qw(%part_svc); +use Getopt::Std; +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; + +use vars qw($opt_d $opt_r $opt_b); +getopts("drb"); + +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 or part numbers to import. +END +my($shell_svcpart)=&getvalue; +my @shell_svcpart = split(/[,\s]+/, $shell_svcpart); + +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 } ); + my @svc_acct = grep { + my $svcpart = $_->cust_svc->svcpart; + grep { $_ == $svcpart } @shell_svcpart; + } qsearch('svc_acct', { 'username' => $username } ); + + next unless @svc_acct; + + if ( scalar(@svc_acct) > 1 ) { + die "more than one $username found!\n"; + next; + } + + my $svc_acct = shift @svc_acct; + + next unless $svc_acct->_password eq '*' + || $opt_r + || ( $opt_b && $svc_acct->_password =~ /^\$2a?\$/ ); + + next if $svc_acct->username eq 'root'; + + next if $password eq 'NP' || $password eq '*LK*'; + + next if $svc_acct->_password eq $password; + next if $svc_acct->_password =~ /^\*SUSPENDED\*/; + + my $new_svc_acct = new FS::svc_acct( { $svc_acct->hash } ); + $new_svc_acct->_password($password); + #warn "$username: ". $svc_acct->_password. " -> $password\n"; + warn "changing password for $username\n"; + unless ( $opt_d ) { + 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 [ -d ] [ -r ] user\n"; +} + diff --git a/bin/slony-setup b/bin/slony-setup new file mode 100755 index 000000000..b384bb9f7 --- /dev/null +++ b/bin/slony-setup @@ -0,0 +1,53 @@ +#!/usr/bin/perl +# +# hack to update/add read-only permissions for a user on the db +# +# usage: pg-readonly freesideuser readonlyuser + +use strict; +use DBI; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(dbdef); + +my $user = shift or die &usage; +adminsuidsetup($user); + +#--- + +#su postgres -c 'createlang plpgsql freeside' + +#--- + +my $MASTERHOST = '172.21.0.204'; +my $SLAVEHOST = '172.21.0.205'; +#my $REPLICATIONUSER='pgsql'; +my $REPLICATIONUSER='postgres'; + +#drop set ( id = 1, origin = 1); + +print <<END; +cluster name = freeside; +node 1 admin conninfo = 'dbname=freeside host=$MASTERHOST user=$REPLICATIONUSER'; +node 2 admin conninfo = 'dbname=freeside host=$SLAVEHOST user=$REPLICATIONUSER'; +init cluster ( id=1, comment = 'Master Node'); +create set (id=1, origin=1, comment='All freeside tables'); + +END + +my $id = 1; + +foreach my $table ( dbdef->tables ) { + #next if $table =~ /^sql_/i; + print "set add table (set id=1, origin=1, id=". $id++. ", fully qualified name = 'public.$table' );\n"; + +} + +print <<END; +store node (id=2, comment = 'Slave node'); +store path (server = 1, client = 2, conninfo='dbname=freeside host=$MASTERHOST user=$REPLICATIONUSER'); +store path (server = 2, client = 1, conninfo='dbname=freeside host=$SLAVEHOST user=$REPLICATIONUSER'); +store listen (origin=1, provider = 1, receiver =2); +store listen (origin=2, provider = 2, receiver =1); +END + + diff --git a/bin/sqlradius-norealm.reimport b/bin/sqlradius-norealm.reimport new file mode 100755 index 000000000..b7d016609 --- /dev/null +++ b/bin/sqlradius-norealm.reimport @@ -0,0 +1,113 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw(%part_svc); +#use Date::Parse; +use DBI; +use Term::Query qw(query); +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? + +$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 $sqlradius_svcpart = &getpart; + +my $datasrc = &getvalue("\n\nEnter the DBI datasource:"); +my $db_user = &getvalue("\n\nEnter the database user:"); +my $db_pass = &getvalue("\n\nEnter the database password:"); + +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"; + +### + +my $dbh = DBI->connect( $datasrc, $db_user, $db_pass ) + or die $DBI::errstr; + +my $sth = $dbh->prepare('SELECT DISTINCT UserName FROM radcheck') + or die $dbh->errstr; +$sth->execute or die $sth->errstr; + +my $row; +while ( defined ( $row = $sth->fetchrow_arrayref ) ) { + my( $username ) = @$row; + + my( $password, $group ) = ( '', '', '' ); + + my $rc_sth = $dbh->prepare( + 'SELECT Attribute, Value'. + ' FROM radcheck'. + ' WHERE UserName = ?' + ) or die $dbh->errstr; + $rc_sth->execute($username) or die $rc_sth->errstr; + + foreach my $rc_row ( @{$rc_sth->fetchall_arrayref} ) { + my($attribute, $value) = @$rc_row; + if ( $attribute =~ /^((Crypt|User)-)?Password$/ ) { + $password = $value unless $password && !$1; + } else { + #handle other params! + } + } + + my @svc_acct = grep { $_->cust_svc->svcpart == $sqlradius_svcpart } + qsearch('svc_acct', { 'username' => $username, } ); + + #print "$r_username / $realm: $password / $finger: "; + print "$username: $password: "; + if ( scalar(@svc_acct) == 0 ) { + print "not found\n"; + next; + } elsif ( scalar(@svc_acct) > 1 ) { + print "multiple matches found?!?!\n"; + next; + } else { + #print "correcting password and name\n"; + print "correcting password\n"; + } + + my $svc_acct = $svc_acct[0]; + #my $new = new FS::svc_acct { $svc_acct->hash, '_password' => $password, 'finger' => $finger }; + my $new = new FS::svc_acct { $svc_acct->hash, '_password' => $password }; + my $error = $new->replace($svc_acct); + #my $error = $new->check; + die "$username: $error" if $error; + +} + +sub usage { + die "Usage:\n\n sqlradius-norealm.reimport user\n"; +} + diff --git a/bin/sqlradius.import b/bin/sqlradius.import new file mode 100644 index 000000000..e75f65b17 --- /dev/null +++ b/bin/sqlradius.import @@ -0,0 +1,152 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw(%part_svc %domain_part_svc); +#use Date::Parse; +use DBI; +use Term::Query qw(query); +use FS::UID qw(adminsuidsetup); #datasrc +use FS::Record qw(qsearch qsearchs); +use FS::svc_acct; +use FS::part_svc; +use FS::svc_domain; + +my $user = shift or die &usage; +adminsuidsetup $user; + +#push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others? + +$FS::svc_Common::noexport_hack = 1; +$FS::svc_domain::whois_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 $sqlradius_svcpart = &getpart; + +%domain_part_svc = map { $_->svcpart, $_ } + qsearch('part_svc', { 'svcdb' => 'svc_domain'} ); + +die "No services with svcdb svc_domain!\n" unless %domain_part_svc; + +print "\n\n", &menu_domain_svc, "\n", <<END; +Enter part number for domains. +END +my $domain_svcpart = &getdomainpart; + +my $datasrc = &getvalue("\n\nEnter the DBI datasource:"); +my $db_user = &getvalue("\n\nEnter the database user:"); +my $db_pass = &getvalue("\n\nEnter the database password:"); + +sub menu_svc { + ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n"; +} +sub menu_domain_svc { + ( join "\n", map "$_: ".$domain_part_svc{$_}->svc, sort keys %domain_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 getdomainpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %domain_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"; + +### + +my $dbh = DBI->connect( $datasrc, $db_user, $db_pass ) + or die $DBI::errstr; + +my $sth = $dbh->prepare('SELECT DISTINCT UserName, Realm FROM radcheck') + or die $dbh->errstr; +$sth->execute or die $sth->errstr; + +my $row; +while ( defined ( $row = $sth->fetchrow_arrayref ) ) { + my( $r_username, $realm ) = @$row; + + my( $username, $domain ); + if ( $r_username =~ /^([^@]+)\@([^@]+)$/ ) { + $username = $1; + $domain = $2; + } else { + $username = $r_username; + $domain = $realm; + } + my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ) + || new FS::svc_domain { + 'domain' => $domain, + 'svcpart' => $domain_svcpart, + 'action' => 'N', + }; + unless ( $svc_domain->svcnum ) { + my $error = $svc_domain->insert; + if ( $error ) { + die "can't insert domain $domain: $error\n"; + } + } + + my( $password, $finger, $group ) = ( '', '', '' ); + + my $rc_sth = $dbh->prepare( + 'SELECT Attribute, Value, Name, GroupName'. + ' FROM radcheck'. + ' WHERE UserName = ? and Realm = ?' + ) or die $dbh->errstr; + $rc_sth->execute($r_username, $realm) or die $rc_sth->errstr; + + foreach my $rc_row ( @{$rc_sth->fetchall_arrayref} ) { + my($attribute, $value, $name, $groupname) = @$rc_row; + if ( $attribute =~ /^((User|Crypt)-)?Password$/ ) { + $password = $value; + $finger = $name; + $group = $groupname; + } else { + #handle other params! + } + } + + my $svc_acct = new FS::svc_acct { + 'svcpart' => $sqlradius_svcpart, + 'username' => $username, + 'domsvc' => $svc_domain->svcnum, + '_password' => $password, + 'finger' => $finger, + }; + + my $error = $svc_acct->insert; + #my $error = $svc_acct->check; + if ( $error ) { + if ( $error =~ /duplicate/i ) { + warn "$r_username / $realm: $error"; + } else { + die "$r_username / $realm: $error"; + } + } + +} + +sub usage { + die "Usage:\n\n sqlradius.import user\n"; +} + diff --git a/bin/sqlradius.reimport b/bin/sqlradius.reimport new file mode 100755 index 000000000..2218a3f13 --- /dev/null +++ b/bin/sqlradius.reimport @@ -0,0 +1,160 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw(%part_svc %domain_part_svc); +#use Date::Parse; +use DBI; +use Term::Query qw(query); +use FS::UID qw(adminsuidsetup); #datasrc +use FS::Record qw(qsearch qsearchs); +use FS::svc_acct; +use FS::part_svc; +use FS::svc_domain; + +my $user = shift or die &usage; +adminsuidsetup $user; + +#push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others? + +$FS::svc_Common::noexport_hack = 1; +$FS::svc_domain::whois_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 $sqlradius_svcpart = &getpart; + +%domain_part_svc = map { $_->svcpart, $_ } + qsearch('part_svc', { 'svcdb' => 'svc_domain'} ); + +die "No services with svcdb svc_domain!\n" unless %domain_part_svc; + +print "\n\n", &menu_domain_svc, "\n", <<END; +Enter part number for domains. +END +my $domain_svcpart = &getdomainpart; + +my $datasrc = &getvalue("\n\nEnter the DBI datasource:"); +my $db_user = &getvalue("\n\nEnter the database user:"); +my $db_pass = &getvalue("\n\nEnter the database password:"); + +sub menu_svc { + ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n"; +} +sub menu_domain_svc { + ( join "\n", map "$_: ".$domain_part_svc{$_}->svc, sort keys %domain_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 getdomainpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %domain_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"; + +### + +my $dbh = DBI->connect( $datasrc, $db_user, $db_pass ) + or die $DBI::errstr; + +my $sth = $dbh->prepare('SELECT DISTINCT UserName, Realm FROM radcheck') + or die $dbh->errstr; +$sth->execute or die $sth->errstr; + +my $row; +while ( defined ( $row = $sth->fetchrow_arrayref ) ) { + my( $r_username, $realm ) = @$row; + + my( $username, $domain ); + if ( $r_username =~ /^([^@]+)\@([^@]+)$/ ) { + $username = $1; + $domain = $2; + } else { + $username = $r_username; + $domain = $realm; + } + my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ) + || new FS::svc_domain { + 'domain' => $domain, + 'svcpart' => $domain_svcpart, + 'action' => 'N', + }; + unless ( $svc_domain->svcnum ) { + die "new domain? wtf"; + my $error = $svc_domain->insert; + if ( $error ) { + die "can't insert domain $domain: $error\n"; + } + } + + #my( $password, $finger, $group ) = ( '', '', '' ); + my( $password, $group ) = ( '', '', '' ); + + my $rc_sth = $dbh->prepare( + 'SELECT Attribute, Value, Name, GroupName'. + ' FROM radcheck'. + ' WHERE UserName = ? and Realm = ?' + ) or die $dbh->errstr; + $rc_sth->execute($r_username, $realm) or die $rc_sth->errstr; + + foreach my $rc_row ( @{$rc_sth->fetchall_arrayref} ) { + my($attribute, $value, $name, $groupname) = @$rc_row; + if ( $attribute =~ /^((Crypt|User)-)?Password$/ ) { + $password = $value; + #$finger = $name; + $group = $groupname; + } else { + #handle other params! + } + } + + my @svc_acct = grep { $_->cust_svc->svcpart == $sqlradius_svcpart } + qsearch('svc_acct', { 'username' => $username, + 'domsvc' => $svc_domain->svcnum, } ); + + #print "$r_username / $realm: $password / $finger: "; + print "$r_username / $realm: $password: "; + if ( scalar(@svc_acct) == 0 ) { + print "not found\n"; + next; + } elsif ( scalar(@svc_acct) > 1 ) { + print "multiple matches found?!?!\n"; + next; + } else { + #print "correcting password and name\n"; + print "correcting password\n"; + } + + my $svc_acct = $svc_acct[0]; + #my $new = new FS::svc_acct { $svc_acct->hash, '_password' => $password, 'finger' => $finger }; + my $new = new FS::svc_acct { $svc_acct->hash, '_password' => $password }; + my $error = $new->replace($svc_acct); + #my $error = $new->check; + die "$r_username / $realm: $error" if $error; + +} + +sub usage { + die "Usage:\n\n sqlradius.reimport user\n"; +} + diff --git a/bin/svc_acct.export b/bin/svc_acct.export new file mode 100755 index 000000000..0bc370fc0 --- /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 000000000..eb94e1c37 --- /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_broadband.renumber b/bin/svc_broadband.renumber new file mode 100755 index 000000000..980fa0099 --- /dev/null +++ b/bin/svc_broadband.renumber @@ -0,0 +1,84 @@ +#!/usr/bin/perl + +use strict; + +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::svc_Common; +use FS::part_svc_router; +use FS::svc_broadband; +use FS::router; +use FS::addr_block; + +$FS::svc_Common::noexport_hack = 1; #Disable exports! + +my $user = shift if $ARGV[0] or die &usage; +adminsuidsetup($user); + +my $remapfile = shift if $ARGV[0] or die &usage; +my $old_blocknum = shift if $ARGV[0] or die &usage; +my $new_blocknum = shift if $ARGV[0] or die &usage; +my $old_svcnum = shift if $ARGV[0]; + +my %ipmap; + +open(REMAP, "<$remapfile") or die $!; +while (<REMAP>) { + next unless (/^([0-9\.]+)\s+([0-9\.]+)$/); + my ($old_ip, $new_ip) = ($1, $2); + $ipmap{$old_ip} = $new_ip; +} +close(REMAP); + +my @svcs; +if ($old_svcnum) { + @svcs = ( qsearchs('svc_broadband', { svcnum => $old_svcnum, + blocknum => $old_blocknum }) ); +} else { + @svcs = qsearch('svc_broadband', { blocknum => $old_blocknum }); +} + +foreach my $old_sb (@svcs) { + + my $old_ip = $old_sb->ip_addr; + my $new_ip = $ipmap{$old_ip}; + print "Renumbering ${old_ip} (${old_blocknum}) => ${new_ip} (${new_blocknum})...\n"; + + + my $new_sb = new FS::svc_broadband + { $old_sb->hash, + ip_addr => $new_ip, + blocknum => $new_blocknum, + svcpart => $old_sb->cust_svc->svcpart, + }; + + my $error = $new_sb->replace($old_sb); + die $error if $error; + +} + + + +exit(0); + +sub usage { + + my $usage = <<EOT; +Usage: + svc_broadband.renumber user remapfile old_blocknum new_blocknum [ svcnum ] + +remapfile format: +old_ip_address new_ip_address +... + +Example remapfile: +10.0.0.5 192.168.0.5 +10.0.0.20 192.168.0.20 +10.0.0.32 192.168.0.3 + +Warning: This assumes your routers have already been reconfigured with the + new addresses. Exports will not be run! + +EOT + +} diff --git a/bin/svc_domain.erase b/bin/svc_domain.erase new file mode 100755 index 000000000..c0236614b --- /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 000000000..c13912c3f --- /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!! +} |