1 package group;

     2 # © Heiko Schlittermann

     3 # $Id$

     4 # $URL$

     5 

     6 use strict;

     7 use warnings;

     8 use Net::LDAP;

     9 use Net::LDAP::Constant qw(LDAP_ALREADY_EXISTS LDAP_NO_SUCH_OBJECT LDAP_TYPE_OR_VALUE_EXISTS);

    10 use Net::LDAP::Entry;

    11 use Cyrus::IMAP::Admin;

    12 use Text::Wrap;

    13 use password;

    14 

    15 

    16 my $Cf;

    17 my ($ldap, $ubase, $abase, $gbase);

    18 my ($imap);

    19 END { $imap and $imap = undef; };

    20 

    21 

    22 sub _add();

    23 sub _list();

    24 sub _delete();

    25 sub uniq(@);

    26 sub verbose(@);

    27 

    28 sub OU_ACCOUNTS();

    29 sub OU_ALIASES();

    30 sub OU_GROUPS();

    31 sub OC_RECIPIENT();

    32 sub OC_ACCESSGROUP();

    33 sub AT_ADDRESS();

    34 sub AT_PRIMARYADDRESS();

    35 sub AT_GROUP();

    36 sub AT_FORWARDINGADDRESS();

    37 sub AT_MEMBERUID();

    38 

    39 sub import(@) {

    40     $Cf = shift;

    41 

    42     require constant;

    43     import constant OU_ACCOUNTS => $Cf->ldap_ou_accounts;

    44     import constant OU_ALIASES => $Cf->ldap_ou_aliases;

    45     import constant OU_GROUPS => $Cf->ldap_ou_groups;

    46     import constant OC_RECIPIENT => $Cf->ldap_oc_recipient;

    47     import constant OC_ACCESSGROUP => $Cf->ldap_oc_accessgroup;

    48     import constant AT_PRIMARYADDRESS => $Cf->ldap_at_primaryaddress;

    49     import constant AT_ADDRESS => $Cf->ldap_at_address;

    50     import constant AT_GROUP => $Cf->ldap_at_group;

    51     import constant AT_FORWARDINGADDRESS => $Cf->ldap_at_forwardingaddress;

    52     import constant AT_MEMBERUID => "memberUid";

    53 

    54     $gbase = OU_GROUPS . "," . $Cf->ldap_base;

    55     $ubase = OU_ACCOUNTS . "," . $Cf->ldap_base;

    56     $abase = OU_ALIASES . "," . $Cf->ldap_base;

    57 }

    58 

    59 sub run($) {

    60     # Eigentlich brauchen wir für alles imap und ldap

    61     $ldap = new Net::LDAP $Cf->ldap_server or die;

    62     my $r = $ldap->bind($Cf->ldap_bind_dn,

    63 	password => $Cf->ldap_password || $ENV{LDAP_PASS} || password::ask("LDAP (". $Cf->ldap_bind_dn .") password: "));

    64     die $r->error, "\n" if $r->code;

    65 

    66     $imap = new Cyrus::IMAP::Admin or die $@;

    67     $imap->authenticate(-server => $Cf->imap_server, -user => $Cf->imap_admin, 

    68 	-password => $Cf->imap_password || $ENV{IMAP_PASS} || password::ask("IMAP (". $Cf->imap_admin .") password: "))

    69     or die $@;

    70 

    71 

    72     if ($Cf->list) { _list() }

    73     elsif ($Cf->add) { _add() }

    74     elsif ($Cf->delete) { _delete() }

    75     elsif ($Cf->modify) { _modify() }

    76     else { die "Need action (--add|--modify|--list|--delete)\n" };

    77 

    78 }

    79 

    80 sub _add() {

    81 # Beim Hinzufügen tragen wir nur das unbedingt notwendige

    82 # ein.  Wenn es schon eine mailPrimaryAddress gibt oder eine

    83 # mail, machen wir gar nichts.

    84 # Ansonsten:

    85 # uid wird hinzugefügt

    86 # cn, sn bleiben unangetastet

    87 # Wenn die mailbox-Option gesetzt ist, wird die

    88 # IMAP-Mailbox angelegt.

    89 

    90 

    91     die "Need group name for creation\n" if not @ARGV;

    92     my $group = shift @ARGV;

    93     my @members = split /,/, $Cf->members||"";

    94 

    95 

    96     my $dn = "cn=$group,$gbase";

    97     my $r;

    98 

    99     verbose("$group:\n");

   100 

   101     verbose("\t$dn...");

   102 

   103     $r = $ldap->search(base => $gbase, filter => "(cn=$group)");

   104 

   105     die $r->error if $r->code;

   106     die "entries not expected" if $r->count > 1;

   107 

   108     my $e;

   109     if ($r->count) {

   110 	$e = $r->shift_entry;

   111     } else {

   112 	$e = new Net::LDAP::Entry;

   113 	# Jetzt eine neue ID finden

   114 	foreach ($Cf->gid_min .. $Cf->gid_max) {

   115 	    # ist einfach eine lineare Suche, im Augenblick weiß ich nichts

   116 	    # clevereres

   117 	    my $r = $ldap->search(base => $gbase,

   118 		filter => "(gidNumber=$_)",

   119 		attrs => []);

   120 	    if ($r->count == 0) {

   121 		$e->add(gidNumber => $_);

   122 		last;

   123 	    }

   124 	}

   125 	$e->dn($dn);

   126 	$e->add(cn => $group);

   127     }

   128 

   129     grep /^CYRUS MAIL ACCESS GROUP/, $e->get("description") or $e->add(description => "CYRUS MAIL ACCESS GROUP");

   130 

   131     if (defined $Cf->description) {

   132 	my @d = map { s/^(CYRUS MAIL ACCESS GROUP).*/"$1: ".$Cf->description/eg; $_ } $e->get("description");

   133 	$e->replace(description => \@d);

   134     }

   135 

   136     $e->replace(objectClass => [uniq $e->get("objectClass"), OC_ACCESSGROUP, "posixGroup"]);

   137     $e->replace(AT_MEMBERUID => [uniq $e->get(AT_MEMBERUID), @members]) if @members;

   138 

   139 

   140     $r = $e->update($ldap);

   141     die $r->error if $r->code;

   142 

   143     verbose("ok");

   144     verbose("\n");

   145 }

   146 

   147 sub _modify() {

   148 # Auch hier gehen wir davon aus, daß die dn direkt aus dem User-Namen folgt:

   149 # dn: uid=USER,...

   150     my (@groups) = @ARGV or die "Need groupname(s)\n";

   151 

   152     my $r = $ldap->search(base => $gbase, 

   153 	filter => $_ = "(&(objectClass=".OC_ACCESSGROUP.")(|" . join("", map { "(cn=$_)" } @ARGV) . "))");

   154     die $r->error if $r->code;

   155     die "No entries found.\n" if $r->count == 0;

   156 

   157     while (my $e = $r->shift_entry) {

   158 	my $r;

   159 

   160 	my $group = $e->get_value("cn");

   161 	my $dn = $e->dn;

   162 

   163 	my $modified = 0;

   164 	verbose "$group:";

   165 

   166 	verbose "\n\t$dn...";

   167 

   168 	if (defined $Cf->members) {

   169 	    my @m = split /,/, $Cf->members;

   170 	    grep { /^[+-]/ } @m or $e->delete(AT_MEMBERUID)

   171 		if $e->get_value(AT_MEMBERUID);

   172 

   173 	    foreach my $m (@m) {

   174 		if ($m =~ s/^-//) {

   175 		    $e->delete((AT_MEMBERUID) => [$m])

   176 		} else {

   177 		    $m =~ s/^\+//;

   178 		    $e->add((AT_MEMBERUID) => [$m])

   179 		}

   180 	    }

   181 	    $modified++;

   182 	}

   183 

   184 	if (defined $Cf->description) {

   185 	    my @d = map { s/^(CYRUS MAIL ACCESS GROUP).*/"$1: ".$Cf->description/eg; $_ } $e->get("description");

   186 	    $e->replace(description => \@d);

   187 	    $modified++;

   188 	}

   189 

   190 	$e->dump if $Cf->debug;

   191 

   192 	if ($modified) {

   193 	    $r = $e->update($ldap);

   194 	    die $r->error.$r->code if $r->code;

   195 	}

   196 

   197 	verbose "ok\n";

   198 

   199 	print "\n";

   200     }

   201 }

   202 

   203 sub _delete() {

   204 # Wir gehen davon aus, daß es einen dn uid=USER,ou=.... gibt, den wir löschen können.

   205 # Wir löschen den kompletten Container.  Es kann natürlich sein, daß er noch jemand anders gehört.  

   206 # Dann ist das Pech.  Um es besser zu haben, müßten wir für alles unsere eigenen

   207 # Objektklassen haben...

   208 

   209     if (!@ARGV) {

   210 	print "Group: ";

   211 	chomp($_ = <>);

   212 	@ARGV = ($_);

   213     }

   214 

   215     #my $filter = "(&((cn=%s)(objectClass=".OC_ACCESSGROUP.")))";

   216 

   217     my $r = $ldap->search(base => $gbase,

   218 	filter => "(&(objectClass=".OC_ACCESSGROUP.")(|" . join("", map { "(cn=$_)" } @ARGV) . "))",

   219 	attrs => [AT_MEMBERUID, "cn"]); 

   220 

   221     if ($r->count == 0) {

   222 	verbose "No objects found\n";

   223 	return;

   224     }

   225 

   226     while (my $e = $r->shift_entry) {

   227 	my $dn = $e->dn;

   228 	verbose $dn;

   229 	my $r = $ldap->delete($dn);

   230 

   231 	if ($r->code == LDAP_NO_SUCH_OBJECT) {

   232 	    verbose("doesn't exist");

   233 	} elsif ($r->code == 0) {

   234 	    verbose(" ok");

   235 	} else {

   236 	    die $r->error;

   237 	}

   238 	verbose("\n");

   239     }

   240 }

   241 

   242 sub _list() {

   243     my $filter;

   244     @ARGV = ("*") unless @ARGV;

   245     #$filter = "(|" . join("", map { "(uid=$_)" } @ARGV) . ")";

   246     $filter = "(objectClass=".OC_ACCESSGROUP.")";

   247 

   248     my $r = $ldap->search(

   249 	filter => $filter,

   250 	base => $gbase,

   251 	attrs => [AT_MEMBERUID, qw/cn description/],

   252     );

   253     die $r->error if $r->code;

   254 

   255 

   256     while (my $e = $r->shift_entry) {

   257 	my $cn = $e->get_value("cn");

   258 	my $descr = $e->get_value("description");

   259 	my @uids = $e->get_value(AT_MEMBERUID);

   260 

   261 	print "$cn: ($descr)\n";

   262 	print "\t", join "\n\t", @uids;

   263 	print "\n";

   264     }

   265 }

   266 

   267 sub verbose(@) {

   268     printf STDERR @_;

   269 }

   270 

   271 sub uniq(@) {

   272     my %x;

   273     @x{@_} = ();

   274     return keys %x;

   275 }

   276 

   277 {   my @pw;

   278 sub _mkpw($) {

   279     my $in = $_[0];

   280 

   281     return $in unless $in and $in eq "{pwgen}";

   282 

   283     if (!@pw) {

   284 	chomp(@pw = `pwgen 8 10 2>/dev/null|| mkpasswd`);

   285 	die "pwgen/mkpasswd: $!" if $?;

   286     }

   287     return shift @pw;

   288     

   289 } }

   290 

   291 1;

   292 # vim:sts=4 sw=4 aw ai sm nohlsearch: