From b0995f6ec4eeaad9c72be4963970f1d69fe1ef02 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 18 Nov 2002 10:15:37 +0000 Subject: [PATCH] preliminary ldap export --- FS/FS/part_export.pm | 32 ++++++ FS/FS/part_export/ldap.pm | 238 ++++++++++++++++++++++++++++++++++++++++ FS/MANIFEST | 2 + FS/t/part_export-ldap.t | 5 + httemplate/edit/part_export.cgi | 2 + 5 files changed, 279 insertions(+) create mode 100644 FS/FS/part_export/ldap.pm create mode 100644 FS/t/part_export-ldap.t diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 5d725ab22..79fe91396 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -724,6 +724,32 @@ tie my %sqlmail_options, 'Tie::IxHash', 'password' => { label=>'Database password' }, ; +tie my %ldap_options, 'Tie::IxHash', + 'dn' => { label=>'DN' }, + 'password' => { label=>'Optional DN password' }, + 'attributes' => { label=>'Attributes', + type=>'textarea', + default=>join("\n", + 'uid $username', + 'mail $username\@$domain', + 'uidno $uid', + 'gidno $gid', + 'cn $first', + 'sn $last', + 'mailquota $quota', + 'vmail', + 'location', + 'mailtag', + 'mailhost', + 'mailmessagestore $dir', + 'userpassword $crypt_password', + 'hint', + 'answer $sec_phrase', + ), + }, + 'radius' => { label=>'Export RADIUS attributes', type=>'checkbox', }, +; + #export names cannot have dashes... %exports = ( @@ -766,6 +792,12 @@ tie my %sqlmail_options, 'Tie::IxHash', 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow the same username with different domains. You will need to setup SSH for unattended operation.', }, + 'ldap' => { + 'desc' => 'Real-time export to LDAP', + 'options' => \%ldap_options, + 'notes' => 'Real-time export to arbitrary LDAP attributes. Requires installation of Net::LDAP from CPAN.', + }, + 'sqlradius' => { 'desc' => 'Real-time export to SQL-backed RADIUS (ICRADIUS, FreeRADIUS)', 'options' => \%sqlradius_options, diff --git a/FS/FS/part_export/ldap.pm b/FS/FS/part_export/ldap.pm new file mode 100644 index 000000000..40f27d695 --- /dev/null +++ b/FS/FS/part_export/ldap.pm @@ -0,0 +1,238 @@ +package FS::part_export::ldap; + +use vars qw(@ISA); +use FS::Record qw( dbh ); +use FS::part_export; + +@ISA = qw(FS::part_export); + +sub rebless { shift; } + +sub _export_insert { + my($self, $svc_acct) = (shift, shift); + + #false laziness w/shellcommands.pm + { + no strict 'refs'; + ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; + ${$_} = $svc_acct->$_() foreach qw( domain ); + my $cust_pkg = $svc_acct->cust_svc->cust_pkg; + if ( $cust_pkg ) { + my $cust_main = $cust_pkg->cust_main; + ${$_} = $cust_main->getfield($_) foreach qw(first last); + } + } + $crypt_password = ''; #surpress "used only once" warnings + $crypt_password = crypt( $svc_acct->_password, + $saltset[int(rand(64))].$saltset[int(rand(64))] ); + + + my %attrib = map { /^\s*(\w+)\s+(.*\S)\s*$/; ( $1 => eval(qq("$2")) ); } + grep { /^\s*(\w+)\s+(.*\S)\s*$/ } + split("\n", $self->option('attributes')); + + if ( $self->option('radius') { + foreach my $table (qw(reply check)) { + my $method = "radius_$table"; + my %radius = $svc_acct->$method(); + foreach my $radius ( keys %radius ) { + ( my $ldap = $radius ) =~ s/\-//g; + $attrib{$ldap} = $radius{$radius}; + } + } + } + + my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'insert', + #$svc_acct->username, + %attrib ); + return $err_or_queue unless ref($err_or_queue); + + #groups with LDAP? + #my @groups = $svc_acct->radius_groups; + #if ( @groups ) { + # my $err_or_queue = $self->ldap_queue( + # $svc_acct->svcnum, 'usergroup_insert', + # $svc_acct->username, @groups ); + # return $err_or_queue unless ref($err_or_queue); + #} + + ''; +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + return "can't (yet?) change username with ldap" + if $old->username ne $new->username; + + return "ldap replace unimplemented"; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $jobnum = ''; + #if ( $old->username ne $new->username ) { + # my $err_or_queue = $self->ldap_queue( $new->svcnum, 'rename', + # $new->username, $old->username ); + # unless ( ref($err_or_queue) ) { + # $dbh->rollback if $oldAutoCommit; + # return $err_or_queue; + # } + # $jobnum = $err_or_queue->jobnum; + #} + + foreach my $table (qw(reply check)) { + my $method = "radius_$table"; + my %new = $new->$method(); + my %old = $old->$method(); + if ( grep { !exists $old{$_} #new attributes + || $new{$_} ne $old{$_} #changed + } keys %new + ) { + my $err_or_queue = $self->ldap_queue( $new->svcnum, 'insert', + $table, $new->username, %new ); + unless ( ref($err_or_queue) ) { + $dbh->rollback if $oldAutoCommit; + return $err_or_queue; + } + if ( $jobnum ) { + my $error = $err_or_queue->depend_insert( $jobnum ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + + my @del = grep { !exists $new{$_} } keys %old; + if ( @del ) { + my $err_or_queue = $self->ldap_queue( $new->svcnum, 'attrib_delete', + $table, $new->username, @del ); + unless ( ref($err_or_queue) ) { + $dbh->rollback if $oldAutoCommit; + return $err_or_queue; + } + if ( $jobnum ) { + my $error = $err_or_queue->depend_insert( $jobnum ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + } + + # (sorta) false laziness with FS::svc_acct::replace + my @oldgroups = @{$old->usergroup}; #uuuh + my @newgroups = $new->radius_groups; + my @delgroups = (); + foreach my $oldgroup ( @oldgroups ) { + if ( grep { $oldgroup eq $_ } @newgroups ) { + @newgroups = grep { $oldgroup ne $_ } @newgroups; + next; + } + push @delgroups, $oldgroup; + } + + if ( @delgroups ) { + my $err_or_queue = $self->ldap_queue( $new->svcnum, 'usergroup_delete', + $new->username, @delgroups ); + unless ( ref($err_or_queue) ) { + $dbh->rollback if $oldAutoCommit; + return $err_or_queue; + } + if ( $jobnum ) { + my $error = $err_or_queue->depend_insert( $jobnum ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + + if ( @newgroups ) { + my $err_or_queue = $self->ldap_queue( $new->svcnum, 'usergroup_insert', + $new->username, @newgroups ); + unless ( ref($err_or_queue) ) { + $dbh->rollback if $oldAutoCommit; + return $err_or_queue; + } + if ( $jobnum ) { + my $error = $err_or_queue->depend_insert( $jobnum ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; +} + +sub _export_delete { + my( $self, $svc_acct ) = (shift, shift); + return "ldap delete unimplemented"; + my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'delete', + $svc_acct->username ); + ref($err_or_queue) ? '' : $err_or_queue; +} + +sub ldap_queue { + my( $self, $svcnum, $method ) = (shift, shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::ldap::ldap_$method", + }; + $queue->insert( + $self->machine, + $self->option('dn'), + $self->option('password'), + @_, + ) or $queue; +} + +sub ldap_insert { #subroutine, not method + my $dn = ldap_connect(shift, shift, shift); + my %attrib = @_; + + my $status = $ldap->add( $dn, attrs => [ %attrib ] ); + die $status->error if $status->is_error; + + $ldap->unbind; +} + +#sub ldap_delete { #subroutine, not method +# my $dbh = ldap_connect(shift, shift, shift); +# my $username = shift; +# +# foreach my $table (qw( radcheck radreply usergroup )) { +# my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" ); +# $sth->execute($username) +# or die "can't delete from $table table: ". $sth->errstr; +# } +# $dbh->disconnect; +#} + +sub ldap_connect { + my( $machine, $dn, $password ) = @_; + + eval "use Net::LDAP"; + die $@ if $@; + + my $ldap = Net::LDAP->net($machine) or die $@; + my $status = $ldap->bind( $dn, password=>$password ); + die $status->error if $status->is_error; + + $dn; +} + diff --git a/FS/MANIFEST b/FS/MANIFEST index e37216e19..47c3bf206 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -75,6 +75,7 @@ FS/part_export/cyrus.pm FS/part_export/domain_shellcommands.pm FS/part_export/http.pm FS/part_export/infostreet.pm +FS/part_export/ldap.pm FS/part_export/null.pm FS/part_export/shellcommands.pm FS/part_export/shellcommands_withdomain.pm @@ -149,6 +150,7 @@ t/part_export-cyrus.t t/part_export-domain_shellcommands.t t/part_export-http.t t/part_export-infostreet.t +t/part_export-ldap.t t/part_export-null.t t/part_export-shellcommands.t t/part_export-shellcommands_withdomain.t diff --git a/FS/t/part_export-ldap.t b/FS/t/part_export-ldap.t new file mode 100644 index 000000000..826c3418d --- /dev/null +++ b/FS/t/part_export-ldap.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::ldap; +$loaded=1; +print "ok 1\n"; diff --git a/httemplate/edit/part_export.cgi b/httemplate/edit/part_export.cgi index bd427aa40..d64526dd4 100644 --- a/httemplate/edit/part_export.cgi +++ b/httemplate/edit/part_export.cgi @@ -70,6 +70,8 @@ my $widget = new HTML::Widgets::SelectLayers( $html .= qq!!; } elsif ( $type eq 'text' ) { $html .= qq!!; + } elsif ( $type eq 'checkbox' ) { + $html .= qq!!; } else { $html .= "unknown type $type"; } -- 2.11.0