alias.pm
branchfoerste-cms
changeset 72 66bf85163780
parent 3 1f0b4cd76cc8
equal deleted inserted replaced
36:59c7146ec6f0 72:66bf85163780
     1 package alias;
     1 package alias;
       
     2 
     2 # © Heiko Schlittermann
     3 # © Heiko Schlittermann
     3 # $Id$
     4 # $Id$
     4 # $URL$
     5 # $URL$
     5 
     6 
     6 use strict;
     7 use strict;
     7 use warnings;
     8 use warnings;
     8 use Net::LDAP;
     9 use Net::LDAP;
     9 use Net::LDAP::Constant qw(
    10 use Net::LDAP::Constant qw(
    10     LDAP_ALREADY_EXISTS 
    11   LDAP_ALREADY_EXISTS
    11     LDAP_NO_SUCH_OBJECT
    12   LDAP_NO_SUCH_OBJECT
    12     LDAP_NO_SUCH_ATTRIBUTE
    13   LDAP_NO_SUCH_ATTRIBUTE
    13     LDAP_TYPE_OR_VALUE_EXISTS);
    14   LDAP_TYPE_OR_VALUE_EXISTS);
    14 use Net::LDAP::Entry;
    15 use Net::LDAP::Entry;
    15 use Text::Wrap;
    16 use Text::Wrap;
    16 
    17 
    17 use password;
    18 use password;
    18 
    19 
    19 my $Cf;
    20 my $Cf;
    20 my ($ldap, $abase, $ubase);
    21 my ( $ldap, $abase, $ubase );
    21 
    22 
    22 sub _add();
    23 sub _add();
    23 sub _list();
    24 sub _list();
    24 sub _delete();
    25 sub _delete();
    25 sub uniq(@);
    26 sub uniq(@);
    35 
    36 
    36 sub import(@) {
    37 sub import(@) {
    37     $Cf = shift;
    38     $Cf = shift;
    38 
    39 
    39     require constant;
    40     require constant;
    40     import constant OU_ACCOUNTS => $Cf->ldap_ou_accounts;
    41     import constant OU_ACCOUNTS          => $Cf->ldap_ou_accounts;
    41     import constant OU_ALIASES => $Cf->ldap_ou_aliases;
    42     import constant OU_ALIASES           => $Cf->ldap_ou_aliases;
    42     import constant OC_ALIAS => $Cf->ldap_oc_alias;
    43     import constant OC_ALIAS             => $Cf->ldap_oc_alias;
    43     import constant AT_FORWARDINGADDRESS => $Cf->ldap_at_forwardingaddress;
    44     import constant AT_FORWARDINGADDRESS => $Cf->ldap_at_forwardingaddress;
    44     import constant AT_GROUP => $Cf->ldap_at_group;
    45     import constant AT_GROUP             => $Cf->ldap_at_group;
    45     import constant AT_PRIMARYADDRESS => $Cf->ldap_at_primaryaddress;
    46     import constant AT_PRIMARYADDRESS    => $Cf->ldap_at_primaryaddress;
    46 
    47 
    47     $abase = OU_ALIASES . "," . $Cf->ldap_base;
    48     $abase = OU_ALIASES . "," . $Cf->ldap_base;
    48     $ubase = OU_ACCOUNTS . "," . $Cf->ldap_base;
    49     $ubase = OU_ACCOUNTS . "," . $Cf->ldap_base;
    49 }
    50 }
    50 
    51 
    51 sub run($) {
    52 sub run($) {
       
    53 
    52     # Eigentlich brauchen wir für alles ldap
    54     # Eigentlich brauchen wir für alles ldap
    53     $ldap = new Net::LDAP $Cf->ldap_server or die;
    55     $ldap = new Net::LDAP $Cf->ldap_server or die;
    54     my $r = $ldap->bind($Cf->ldap_bind_dn,
    56     my $r = $ldap->bind( $Cf->ldap_bind_dn,
    55 	password => $Cf->ldap_password || $ENV{LDAP_PASS} || password::ask("LDAP (". $Cf->ldap_bind_dn .") password: "));
    57              password => $Cf->ldap_password
       
    58           || $ENV{LDAP_PASS}
       
    59           || password::ask( "LDAP (" . $Cf->ldap_bind_dn . ") password: " ) );
    56     die $r->error, "\n" if $r->code;
    60     die $r->error, "\n" if $r->code;
    57 
    61 
    58 
    62     if    ( $Cf->list )   { _list() }
    59     if ($Cf->list) { _list() }
    63     elsif ( $Cf->add )    { _add() }
    60     elsif ($Cf->add) { _add() }
    64     elsif ( $Cf->delete ) { _delete() }
    61     elsif ($Cf->delete) { _delete() }
    65     elsif ( $Cf->modify ) { _modify() }
    62     elsif ($Cf->modify) { _modify() }
    66     else { die "Need action (--add|--modify|--list|--delete)\n" }
    63     else { die "Need action (--add|--modify|--list|--delete)\n" };
       
    64 
    67 
    65 }
    68 }
    66 
    69 
    67 sub _add() {
    70 sub _add() {
    68 # Wenn's den Alias schon gibt, wird er nicht mehr
    71 
    69 # angelegt
    72     # Wenn's den Alias schon gibt, wird er nicht mehr
       
    73     # angelegt
    70 
    74 
    71     die "Need alias name for creation\n" if not @ARGV;
    75     die "Need alias name for creation\n" if not @ARGV;
    72     die "Need members\n" if not defined $Cf->members;
    76     die "Need members\n" if not defined $Cf->members;
    73     my $alias = shift @ARGV;
    77     my $alias   = shift @ARGV;
    74     my @members = split /,/, $Cf->members;
    78     my @members = split /,/, $Cf->members;
    75     my $dn = "mail=$alias,$abase";
    79     my $dn      = "mail=$alias,$abase";
    76 
    80 
    77     my $r;
    81     my $r;
    78 
    82 
    79     verbose("$alias:\n");
    83     verbose("$alias:\n");
    80     verbose("\t$dn...");
    84     verbose("\t$dn...");
    81 
    85 
    82     $r = $ldap->search(base => $abase, filter => "(mail=$alias)");
    86     $r = $ldap->search( base => $abase, filter => "(mail=$alias)" );
    83     die $r->error if $r->code;
    87     die $r->error if $r->code;
    84     die "Multiple entries not expected" if $r->count > 1;
    88     die "Multiple entries not expected" if $r->count > 1;
    85     
    89 
    86     $r = $ldap->add($dn, attrs => [
    90     $r = $ldap->add(
    87 	objectClass => OC_ALIAS,
    91         $dn,
    88 	mail => $alias,
    92         attrs => [
    89 	(AT_FORWARDINGADDRESS) => \@members
    93             objectClass            => OC_ALIAS,
    90     ]);
    94             mail                   => $alias,
    91     if ($r->code == LDAP_ALREADY_EXISTS) { verbose "exists" }
    95             (AT_FORWARDINGADDRESS) => \@members
    92     elsif ($r->code) { die $r->error } 
    96         ]
    93     else { verbose "ok" }
    97     );
       
    98     if    ( $r->code == LDAP_ALREADY_EXISTS ) { verbose "exists" }
       
    99     elsif ( $r->code )                        { die $r->error }
       
   100     else                                      { verbose "ok" }
    94 
   101 
    95     verbose("\n");
   102     verbose("\n");
    96 }
   103 }
    97 
   104 
    98 sub _modify() {
   105 sub _modify() {
    99 # Auch hier gehen wir davon aus, daß die dn direkt aus dem Alias-Namen folgt:
   106 
   100 # dn: cn=USER,...
   107     # Auch hier gehen wir davon aus, daß die dn direkt aus dem Alias-Namen folgt:
   101 # Jetzt behandeln wir lediglich die Modifikation auf Basis eines
   108     # dn: cn=USER,...
   102 # alias-Namens!
   109     # Jetzt behandeln wir lediglich die Modifikation auf Basis eines
       
   110     # alias-Namens!
   103 
   111 
   104     my (@users) = @ARGV or die "Need alias names(s)\n";
   112     my (@users) = @ARGV or die "Need alias names(s)\n";
   105     my @members = split /,/, $Cf->members;
   113     my @members = split /,/, $Cf->members;
   106     my @add = grep { s/^\+// } @_ = @members;
   114     my @add = grep { s/^\+// } @_ = @members;
   107     my @del = grep { s/^-// } @_ = @members;
   115     my @del = grep { s/^-// } @_  = @members;
   108     my @set = grep { !/^[\+-]/ } @members;
   116     my @set = grep { !/^[\+-]/ } @members;
   109 
   117 
   110 
       
   111     foreach my $alias (@ARGV) {
   118     foreach my $alias (@ARGV) {
   112 	my $dn = "mail=$alias,$abase";
   119         my $dn = "mail=$alias,$abase";
   113 	verbose "$alias:";
   120         verbose "$alias:";
   114 
   121 
   115 	my $r = $ldap->search(base => $abase, filter => "(mail=$alias)");
   122         my $r = $ldap->search( base => $abase, filter => "(mail=$alias)" );
   116 	die $r->error if $r->code;
   123         die $r->error if $r->code;
   117 
   124 
   118 	if ($r->count == 0) {
   125         if ( $r->count == 0 ) {
   119 	    verbose " not found\n";
   126             verbose " not found\n";
   120 	    next;
   127             next;
   121 	}
   128         }
   122 
   129 
   123 	while (my $e = $r->shift_entry) {
   130         while ( my $e = $r->shift_entry ) {
   124 
   131 
   125 	    verbose "\n\t" . $e->dn . " ";
   132             verbose "\n\t" . $e->dn . " ";
   126 
   133 
   127 	    if (@set) {
   134             if (@set) {
   128 		$e->replace((AT_FORWARDINGADDRESS) => \@set);
   135                 $e->replace( (AT_FORWARDINGADDRESS) => \@set );
   129 	    } else {
   136             } else {
   130 		@add and $e->replace((AT_FORWARDINGADDRESS) => [uniq $e->get(AT_FORWARDINGADDRESS), @add]);
   137                 @add
   131 		@del and $e->delete((AT_FORWARDINGADDRESS) => \@del);
   138                   and $e->replace( (AT_FORWARDINGADDRESS) =>
   132 	    }
   139                       [ uniq $e->get(AT_FORWARDINGADDRESS), @add ] );
   133 
   140                 @del and $e->delete( (AT_FORWARDINGADDRESS) => \@del );
   134 	    $e->dump if $Cf->debug;
   141             }
   135 
   142 
   136 	    my $r = $e->update($ldap);
   143             $e->dump if $Cf->debug;
   137 	    if ($r->code == LDAP_NO_SUCH_ATTRIBUTE) {
   144 
   138 		verbose "no member";
   145             my $r = $e->update($ldap);
   139 	    } elsif ($r->code) {
   146             if ( $r->code == LDAP_NO_SUCH_ATTRIBUTE ) {
   140 		die $r->error . "/" . $r->code;
   147                 verbose "no member";
   141 	    }  else {
   148             } elsif ( $r->code ) {
   142 		verbose "ok";
   149                 die $r->error . "/" . $r->code;
   143 	    }
   150             } else {
   144 	}
   151                 verbose "ok";
   145 
   152             }
   146 	print "\n";
   153         }
       
   154 
       
   155         print "\n";
   147     }
   156     }
   148 }
   157 }
   149 
   158 
   150 sub _delete() {
   159 sub _delete() {
   151 # Wir gehen davon aus, daß es einen dn mail=ALIAS,ou=MailAliases,...
   160 
   152 # gibt und löschen diesen gnadenlos.
   161     # Wir gehen davon aus, daß es einen dn mail=ALIAS,ou=MailAliases,...
   153 
   162     # gibt und löschen diesen gnadenlos.
   154     if (!@ARGV) {
   163 
   155 	print "User: ";
   164     if ( !@ARGV ) {
   156 	chomp($_ = <>);
   165         print "User: ";
   157 	@ARGV = ($_);
   166         chomp( $_ = <> );
       
   167         @ARGV = ($_);
   158     }
   168     }
   159 
   169 
   160     foreach (@ARGV) {
   170     foreach (@ARGV) {
   161 	my $dn = "mail=$_,$abase";
   171         my $dn = "mail=$_,$abase";
   162 
   172 
   163 	verbose("$_:\n");
   173         verbose("$_:\n");
   164 	verbose("\tdeleting $dn...");
   174         verbose("\tdeleting $dn...");
   165 	my $r = $ldap->delete($dn);
   175         my $r = $ldap->delete($dn);
   166 
   176 
   167 	if ($r->code == LDAP_NO_SUCH_OBJECT) {
   177         if ( $r->code == LDAP_NO_SUCH_OBJECT ) {
   168 	    verbose("doesn't exist");
   178             verbose("doesn't exist");
   169 	} elsif ($r->code == 0) {
   179         } elsif ( $r->code == 0 ) {
   170 	    verbose("ok");
   180             verbose("ok");
   171 	} else {
   181         } else {
   172 	    die $r->error;
   182             die $r->error;
   173 	}
   183         }
   174 	
   184 
   175 	verbose("\n");
   185         verbose("\n");
   176 
   186 
   177     }
   187     }
   178 }
   188 }
   179 
   189 
   180 sub _list() {
   190 sub _list() {
   181     my $filter;
   191     my $filter;
   182     @ARGV = ("*") unless @ARGV;
   192     @ARGV = ("*") unless @ARGV;
   183     $filter = "(|" . join("", map { "(mail=$_)" } @ARGV) . ")";
   193     $filter = "(|" . join( "", map { "(mail=$_)" } @ARGV ) . ")";
   184 
   194 
   185     my $r = $ldap->search(
   195     my $r = $ldap->search(
   186 	filter => $filter,
   196         filter => $filter,
   187 	base => $abase,
   197         base   => $abase,
   188 	attrs => [qw/mail/, AT_FORWARDINGADDRESS],
   198         attrs  => [ qw/mail/, AT_FORWARDINGADDRESS ],
   189     );
   199     );
   190 
   200 
   191     die $r->error if $r->code;
   201     die $r->error if $r->code;
   192 
   202 
   193     $Text::Wrap::columns = columns() || 80;
   203     $Text::Wrap::columns = columns() || 80;
   194 
   204 
   195     while (my $e = $r->shift_entry) {
   205     while ( my $e = $r->shift_entry ) {
   196 	my $mail = $e->get("mail");
   206         my $mail = $e->get("mail");
   197 
   207 
   198 	print wrap("", "\t", $e->get_value("mail") 
   208         print wrap( "", "\t",
   199 	    . ": "
   209                 $e->get_value("mail") . ": "
   200 	    . join(", ", $e->get(AT_FORWARDINGADDRESS))
   210               . join( ", ", $e->get(AT_FORWARDINGADDRESS) )
   201 	    . "\n");
   211               . "\n" );
   202 	    
   212 
   203     }
   213     }
   204 
   214 
   205     $filter = "(|" . join("", map { "(".AT_GROUP."=$_)" } @ARGV) . ")";
   215     $filter = "(|" . join( "", map { "(" . AT_GROUP . "=$_)" } @ARGV ) . ")";
   206     $r = $ldap->search(
   216     $r = $ldap->search(
   207 	filter => $filter,
   217         filter => $filter,
   208 	base => $ubase,
   218         base   => $ubase,
   209 	attrs => [AT_GROUP, AT_PRIMARYADDRESS]
   219         attrs  => [ AT_GROUP, AT_PRIMARYADDRESS ]
   210     );
   220     );
   211     die $r->error if $r->code;
   221     die $r->error if $r->code;
   212 
   222 
   213     my %group;
   223     my %group;
   214     while (my $e = $r->shift_entry) {
   224     while ( my $e = $r->shift_entry ) {
   215 	my $mail = $e->get_value(AT_PRIMARYADDRESS);
   225         my $mail = $e->get_value(AT_PRIMARYADDRESS);
   216 	foreach my $g ($e->get_value(AT_GROUP)) {
   226         foreach my $g ( $e->get_value(AT_GROUP) ) {
   217 	    push @{$group{$g}}, $mail;
   227             push @{ $group{$g} }, $mail;
   218 	}
   228         }
   219     }
   229     }
   220     foreach my $g (keys %group) {
   230     foreach my $g ( keys %group ) {
   221 	print wrap("", "\t", "$g⇒ " . join(", ", @{$group{$g}}) . "\n");
   231         print wrap( "", "\t", "$g⇒ " . join( ", ", @{ $group{$g} } ) . "\n" );
   222     }
   232     }
   223 }
   233 }
   224 
   234 
   225 sub verbose(@) {
   235 sub verbose(@) {
   226     printf STDERR @_;
   236     printf STDERR @_;
   236     `stty -a` =~ /columns\s+(\d+)/;
   246     `stty -a` =~ /columns\s+(\d+)/;
   237     $1;
   247     $1;
   238 }
   248 }
   239 
   249 
   240 1;
   250 1;
       
   251 
   241 # vim:sts=4 sw=4 aw ai sm:
   252 # vim:sts=4 sw=4 aw ai sm: