adding export to read mailbox status information, RT#15987
[freeside.git] / bin / sqlradius.reimport
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 $FS::svc_domain::whois_hack = 1;
21
22 ###
23
24 %part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
25
26 die "No services with svcdb svc_acct!\n" unless %part_svc;
27
28 print "\n\n", &menu_svc, "\n", <<END;
29 Enter part number to import.
30 END
31 my $sqlradius_svcpart = &getpart;
32
33 %domain_part_svc = map { $_->svcpart, $_ }
34                        qsearch('part_svc', { 'svcdb' => 'svc_domain'} );
35
36 die "No services with svcdb svc_domain!\n" unless %domain_part_svc;
37
38 print "\n\n", &menu_domain_svc, "\n", <<END;
39 Enter part number for domains.
40 END
41 my $domain_svcpart = &getdomainpart;
42
43 my $datasrc = &getvalue("\n\nEnter the DBI datasource:");
44 my $db_user = &getvalue("\n\nEnter the database user:");
45 my $db_pass = &getvalue("\n\nEnter the database password:");
46
47 sub menu_svc {
48   ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
49 }
50 sub menu_domain_svc {
51   ( join "\n", map "$_: ".$domain_part_svc{$_}->svc, sort keys %domain_part_svc ). "\n";
52 }
53 sub getpart {
54   $^W=0; # Term::Query isn't -w-safe
55   my $return = query "Enter part number:", 'irk', [ keys %part_svc ];
56   $^W=1;
57   $return;
58 }
59 sub getdomainpart {
60   $^W=0; # Term::Query isn't -w-safe
61   my $return = query "Enter part number:", 'irk', [ keys %domain_part_svc ];
62   $^W=1;
63   $return;
64 }
65 sub getvalue {
66   my $prompt = shift;
67   $^W=0; # Term::Query isn't -w-safe
68   my $return = query $prompt, '';
69   $^W=1;
70   $return;
71 }
72
73 print "\n\n";
74
75 ###
76
77 my $dbh = DBI->connect( $datasrc, $db_user, $db_pass )
78   or die $DBI::errstr;
79
80 my $sth = $dbh->prepare('SELECT DISTINCT UserName, Realm FROM radcheck')
81   or die $dbh->errstr;
82 $sth->execute or die $sth->errstr;
83
84 my $row;
85 while ( defined ( $row = $sth->fetchrow_arrayref ) ) {
86   my( $r_username, $realm ) = @$row;
87
88   my( $username, $domain );
89   if ( $r_username =~ /^([^@]+)\@([^@]+)$/ ) {
90     $username = $1;
91     $domain = $2;
92   } else {
93     $username = $r_username;
94     $domain = $realm;
95   }
96   my $svc_domain = qsearchs('svc_domain', { 'domain'  => $domain } )
97                    || new FS::svc_domain {
98                                            'domain'  => $domain,
99                                            'svcpart' => $domain_svcpart,
100                                            'action'  => 'N',
101                                          };
102   unless ( $svc_domain->svcnum ) {
103     die "new domain?  wtf";
104     my $error = $svc_domain->insert;
105     if ( $error ) {
106       die "can't insert domain $domain: $error\n";
107     }
108   }
109
110   #my( $password, $finger, $group ) = ( '', '', '' );
111   my( $password, $group ) = ( '', '', '' );
112
113   my $rc_sth = $dbh->prepare(
114     'SELECT Attribute, Value, Name, GroupName'.
115     '  FROM radcheck'.
116     '  WHERE UserName = ? and Realm = ?'
117   ) or die $dbh->errstr;
118   $rc_sth->execute($r_username, $realm) or die $rc_sth->errstr;
119
120   foreach my $rc_row ( @{$rc_sth->fetchall_arrayref} ) {
121     my($attribute, $value, $name, $groupname) = @$rc_row;
122     if ( $attribute =~ /^((Crypt|User)-)?Password$/ ) {
123       $password = $value;
124       #$finger = $name;
125       $group = $groupname;
126     } else {
127       #handle other params!
128     }
129   }
130
131   my @svc_acct = grep { $_->cust_svc->svcpart == $sqlradius_svcpart } 
132                  qsearch('svc_acct', { 'username' => $username,
133                                        'domsvc'   => $svc_domain->svcnum, } );
134
135   #print "$r_username / $realm: $password / $finger: ";
136   print "$r_username / $realm: $password: ";
137   if ( scalar(@svc_acct) == 0 ) {
138     print "not found\n";
139     next;
140   } elsif ( scalar(@svc_acct) > 1 ) {
141     print "multiple matches found?!?!\n";
142     next;
143   } else {
144     #print "correcting password and name\n";
145     print "correcting password\n";
146   }
147
148   my $svc_acct = $svc_acct[0];
149   #my $new = new FS::svc_acct { $svc_acct->hash, '_password' => $password, 'finger' => $finger };
150   my $new = new FS::svc_acct { $svc_acct->hash, '_password' => $password };
151   my $error = $new->replace($svc_acct);
152   #my $error = $new->check;
153   die "$r_username / $realm: $error" if $error;
154
155 }
156
157 sub usage {
158   die "Usage:\n\n  sqlradius.reimport user\n";
159 }
160