bin/sqlradius.import

   1 #!/usr/bin/perl -Tw
   2
   3 use strict;
   4 use vars qw(%part_svc %domain_part_svc);
   5 #use Date::Parse;
   6 use DBI;
   7 use Term::Query qw(query);
   8 use FS::UID qw(adminsuidsetup); #datasrc
   9 use FS::Record qw(qsearch qsearchs);
  10 use FS::svc_acct;
  11 use FS::part_svc;
  12 use FS::svc_domain;
  13
  14 my $user = shift or die &usage;
  15 adminsuidsetup $user;
  16
  17 #push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others?
  18
  19 $FS::svc_Common::noexport_hack = 1;
  20
  21 ###
  22
  23 %part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
  24
  25 die "No services with svcdb svc_acct!\n" unless %part_svc;
  26
  27 print "\n\n", &menu_svc, "\n", <<END;
  28 Enter part number to import.
  29 END
  30 my $sqlradius_svcpart = &getpart;
  31
  32 %domain_part_svc = map { $_->svcpart, $_ }
  33                        qsearch('part_svc', { 'svcdb' => 'svc_domain'} );
  34
  35 die "No services with svcdb svc_domain!\n" unless %domain_part_svc;
  36
  37 print "\n\n", &menu_domain_svc, "\n", <<END;
  38 Enter part number for domains.
  39 END
  40 my $domain_svcpart = &getdomainpart;
  41
  42 my $datasrc = &getvalue("\n\nEnter the DBI datasource:");
  43 my $db_user = &getvalue("\n\nEnter the database user:");
  44 my $db_pass = &getvalue("\n\nEnter the database password:");
  45
  46 sub menu_svc {
  47   ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
  48 }
  49 sub menu_domain_svc {
  50   ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %domain_part_svc ). "\n";
  51 }
  52 sub getpart {
  53   $^W=0; # Term::Query isn't -w-safe
  54   my $return = query "Enter part number:", 'irk', [ keys %part_svc ];
  55   $^W=1;
  56   $return;
  57 }
  58 sub getdomainpart {
  59   $^W=0; # Term::Query isn't -w-safe
  60   my $return = query "Enter part number:", 'irk', [ keys %domain_part_svc ];
  61   $^W=1;
  62   $return;
  63 }
  64 sub getvalue {
  65   my $prompt = shift;
  66   $^W=0; # Term::Query isn't -w-safe
  67   my $return = query $prompt, '';
  68   $^W=1;
  69   $return;
  70 }
  71
  72 print "\n\n";
  73
  74 ###
  75
  76 my $dbh = DBI->connect( $datasrc, $db_user, $db_pass )
  77   or die $DBI::errstr;
  78
  79 my $sth = $dbh->prepare('SELECT DISTINCT UserName, Realm FROM radcheck')
  80   or die $dbh->errstr;
  81 $sth->execute or die $sth->errstr;
  82
  83 my $row;
  84 while ( $row = $sth->fetchrow_arrayref ) {
  85   my( $r_username, $realm ) = @$row;
  86
  87   my( $username, $domain );
  88   if ( $r_username =~ s/([^@]+)\@([^@]+)$// ) {
  89     $username = $1;
  90     $domain = $2;
  91   } else {
  92     $username = $r_username;
  93     $domain = $realm;
  94   }
  95   my %svc_domain = ( 'svcpart' => $domain_svcpart,
  96                      'domain'  => $domain,         );
  97   my $svc_domain = qsearchs('svc_domain', \%svc_domain )
  98                    || new FS::svc_domain \%svc_domain;
  99   unless ( $svc_domain->domsvc ) {
 100     my $error = $svc_domain->insert;
 101     if ( $error ) {
 102       die "can't insert domain $domain: $error\n";
 103     }
 104   }
 105
 106   my( $password, $finger, $group ) = ( '', '', '' );
 107
 108   my $rc_sth = $dbh->prepare(
 109     'SELECT Attribute, Value, Name, GroupName'.
 110     '  FROM radcheck'.
 111     '  WHERE UserName = ? and Realm = ?'
 112   ) or die $dbh->errstr;
 113   $rc_sth->execute($r_username, $realm) or die $rc_sth->errstr;
 114
 115   foreach my $rc_row ( @{$rc_sth->fetchall_arrayref} ) {
 116     my($attribute, $value, $name, $groupname) = @$row;
 117     if ( $attribute =~ /^(Crypt-)?Password$/ ) {
 118       $password = $value;
 119       $finger = $name;
 120       $group = $groupname;
 121     } else {
 122       #handle other params!
 123     }
 124   }
 125
 126   my $svc_acct = new FS::svc_acct (
 127     'svcpart'   => $sqlradius_svcpart,
 128     'username'  => $username,
 129     'domsvc'    => $svc_domain->domsvc,
 130     '_password' => $password,
 131     'finger'    => $finger,
 132   );
 133
 134   my($error);
 135   #$error = $svc_acct->insert;
 136   $error = $svc_acct->check;
 137   if ( $error ) {
 138     if ( $error =~ /duplicate/i ) {
 139       warn "$r_username: $error";
 140     } else {
 141       die "$r_username: $error";
 142     }
 143   }
 144
 145 }
 146
 147 sub usage {
 148   die "Usage:\n\n  sqlradius.import user\n";
 149 }
 150