git.maemo.org Git - samba/blob - examples/LDAP/smbldap-tools-0.9.1/smbldap_tools.pm

   1 #!/usr/bin/perl -w
   2 use strict;
   3 package smbldap_tools;
   4 use Net::LDAP;
   5 use Crypt::SmbHash;
   6
   7
   8 # $Id: smbldap_tools.pm,v 1.62 2005/05/27 14:28:47 jtournier Exp $
   9 #
  10 #  This code was developped by IDEALX (http://IDEALX.org/) and
  11 #  contributors (their names can be found in the CONTRIBUTORS file).
  12 #
  13 #                 Copyright (C) 2001-2002 IDEALX
  14 #
  15 #  This program is free software; you can redistribute it and/or
  16 #  modify it under the terms of the GNU General Public License
  17 #  as published by the Free Software Foundation; either version 2
  18 #  of the License, or (at your option) any later version.
  19 #
  20 #  This program is distributed in the hope that it will be useful,
  21 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 #  GNU General Public License for more details.
  24 #
  25 #  You should have received a copy of the GNU General Public License
  26 #  along with this program; if not, write to the Free Software
  27 #  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
  28 #  USA.
  29
  30
  31 # ugly funcs using global variables and spawning openldap clients
  32
  33 my $smbldap_conf;
  34 if (-e "/etc/smbldap-tools/smbldap.conf") {
  35         $smbldap_conf="/etc/smbldap-tools/smbldap.conf";
  36 } else {
  37         $smbldap_conf="/etc/opt/IDEALX/smbldap-tools/smbldap.conf";
  38 }
  39 my $smbldap_bind_conf;
  40 if (-e "/etc/smbldap-tools/smbldap_bind.conf") {
  41         $smbldap_bind_conf="/etc/smbldap-tools/smbldap_bind.conf";
  42 } else {
  43         $smbldap_bind_conf="/etc/opt/IDEALX/smbldap-tools/smbldap_bind.conf";
  44 }
  45 my $samba_conf;
  46 if (-e "/etc/samba/smb.conf") {
  47         $samba_conf="/etc/samba/smb.conf";
  48 } else {
  49         $samba_conf="/usr/local/samba/lib/smb.conf";
  50 }
  51
  52 use vars       qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  53 use Exporter;
  54 $VERSION = 1.00;
  55
  56 @ISA = qw(Exporter);
  57 use vars qw(%config $ldap);
  58
  59 @EXPORT = qw(
  60              get_user_dn
  61              get_group_dn
  62              is_group_member
  63              is_samba_user
  64              is_unix_user
  65              is_user_valid
  66              does_sid_exist
  67              get_dn_from_line
  68              add_posix_machine
  69              add_samba_machine
  70              add_samba_machine_smbpasswd
  71              group_add_user
  72              add_grouplist_user
  73              disable_user
  74              delete_user
  75              group_add
  76              group_del
  77              get_homedir
  78              read_user
  79              read_user_entry
  80              read_group
  81              read_group_entry
  82              read_group_entry_gid
  83              find_groups_of
  84              parse_group
  85              group_remove_member
  86              group_get_members
  87              do_ldapadd
  88              do_ldapmodify
  89              get_user_dn2
  90              connect_ldap_master
  91              connect_ldap_slave
  92              group_type_by_name
  93              subst_configvar
  94              read_config
  95              read_parameter
  96              subst_user
  97              split_arg_comma
  98              list_union
  99              list_minus
 100              get_next_id
 101              print_banner
 102              getDomainName
 103              getLocalSID
 104              %config
 105             );
 106
 107 sub print_banner
 108   {
 109        print STDERR "(c) Jerome Tournier - IDEALX 2004 (http://www.idealx.com)- Licensed under the GPL\n"
 110          unless $config{no_banner};
 111   }
 112
 113 sub read_parameter
 114   {
 115         my $line=shift;
 116         ## check for a param = value
 117         if ($_=~/=/) {
 118           my ($param,$val);
 119           if ($_=~/\s*.*?\s*=\s*".*"/) {
 120                 ($param,$val) = /\s*(.*?)\s*=\s*"(.*)"/;
 121           } elsif ($_=~/\s*.*?\s*=\s*'.*'/) {
 122                 ($param,$val) = /\s*(.*?)\s*=\s*'(.*)'/;
 123           } else {
 124                 ($param,$val) = /\s*(.*?)\s*=\s*(.*)/;
 125           }
 126           return ($param,$val);
 127         }
 128   }
 129
 130 sub subst_configvar
 131   {
 132         my $value = shift;
 133         my $vars = shift;
 134
 135         $value =~ s/\$\{([^}]+)\}/$vars->{$1} ? $vars->{$1} : $1/eg;
 136         return $value;
 137   }
 138
 139 sub read_conf
 140   {
 141         my %conf;
 142         open (CONFIGFILE, "$smbldap_conf") || die "Unable to open $smbldap_conf for reading !\n";
 143         while (<CONFIGFILE>) {
 144           chomp($_);
 145           ## throw away comments
 146           next if ( /^\s*#/ || /^\s*$/ || /^\s*\;/);
 147           ## check for a param = value
 148           my ($parameter,$value)=read_parameter($_);
 149           $value = &subst_configvar($value, \%conf);
 150           $conf{$parameter}=$value;
 151         }
 152         close (CONFIGFILE);
 153
 154         if ($< == 0) {
 155           open (CONFIGFILE, "$smbldap_bind_conf") || die "Unable to open $smbldap_bind_conf for reading !\n";
 156           while (<CONFIGFILE>) {
 157                 chomp($_);
 158                 ## throw away comments
 159                 next if ( /^\s*#/ || /^\s*$/ || /^\s*\;/);
 160                 ## check for a param = value
 161                 my ($parameter,$value)=read_parameter($_);
 162                 $value = &subst_configvar($value, \%conf);
 163                 $conf{$parameter}=$value;
 164           }
 165           close (CONFIGFILE);
 166         } else {
 167           $conf{slaveDN}=$conf{slavePw}=$conf{masterDN}=$conf{masterPw}="";
 168         }
 169        # automatically find SID
 170        if (not $conf{SID}) {
 171          $conf{SID} = getLocalSID() ||
 172            die "Unable to determine domain SID: please edit your smbldap.conf,
 173   or start your samba server for a few minutes to allow for SID generation to proceed\n";
 174        }
 175         return(%conf);
 176   }
 177
 178 sub read_smbconf
 179   {
 180     my %conf;
 181     my $smbconf="$samba_conf";
 182     open (CONFIGFILE, "$smbconf") || die "Unable to open $smbconf for reading !\n";
 183     my $global=0;
 184     while (<CONFIGFILE>) {
 185      chomp;
 186       if (/^\[global\]/) {
 187         $global=1;
 188       }
 189       if ($global == 1) {
 190         if (/^\[/ and !/\[global\]/) {
 191           $global=0;
 192         } else {
 193           ## throw away comments
 194           #next if ( ! /workgroup/i );
 195           next if ( /^\s*#/ || /^\s*$/ || /^\s*\;/ || /\[/);
 196           ## check for a param = value
 197           my ($parameter,$value)=read_parameter($_);
 198           $value = &subst_configvar($value, \%conf);
 199           $conf{$parameter}=$value;
 200         }
 201       }
 202     }
 203     close (CONFIGFILE);
 204     return(%conf);
 205   }
 206 my %smbconf=read_smbconf();
 207
 208 sub getLocalSID {
 209   my $string = `LANG= PATH=/opt/IDEALX/bin:/usr/local/bin:/usr/bin:/bin net getlocalsid 2>/dev/null`;
 210   my ($domain,$sid)=($string =~ m/^SID for domain (\S+) is: (\S+)$/ );
 211
 212   return $sid;
 213 }
 214
 215 # let's read the configurations file...
 216 %config=read_conf();
 217
 218 sub get_parameter {
 219   # this function return the value for a parameter. The name of the parameter can be either this
 220   # defined in smb.conf or smbldap.conf
 221   my $parameter_smb=shift;
 222   my $parameter_smbldap=shift;
 223   if (defined $config{$parameter_smbldap} and $config{$parameter_smbldap} ne "") {
 224         return $config{$parameter_smbldap};
 225   } elsif (defined $smbconf{$parameter_smb} and $smbconf{$parameter_smb} ne "") {
 226         return $smbconf{$parameter_smb};
 227   } else {
 228         #print "could not find parameter's value (parameter given: $parameter_smbldap or $parameter_smb) !!\n";
 229         undef $smbconf{$parameter_smb};
 230   }
 231
 232 }
 233
 234 $config{sambaDomain}=get_parameter("workgroup","sambaDomain");
 235 $config{suffix}=get_parameter("ldap suffix","suffix");
 236 $config{usersdn}=get_parameter("ldap user suffix","usersdn");
 237 if ($config{usersdn} !~ m/,/ ) {$config{usersdn}=$config{usersdn}.",".$config{suffix};}
 238 $config{groupsdn}=get_parameter("ldap group suffix","groupsdn");
 239 if ($config{groupsdn} !~ m/,/ ) {$config{groupsdn}=$config{groupsdn}.",".$config{suffix};}
 240 $config{computersdn}=get_parameter("ldap machine suffix","computersdn");
 241 if ($config{computersdn} !~ m/,/ ) {$config{computersdn}=$config{computersdn}.",".$config{suffix};}
 242 $config{idmapdn}=get_parameter("ldap idmap suffix","idmapdn");
 243 if (defined $config{idmapdn}) {
 244         if ($config{idmapdn} !~ m/,/ ) {$config{idmapdn}=$config{idmapdn}.",".$config{suffix};}
 245 }
 246
 247 # next uidNumber and gidNumber available are stored in sambaDomainName object
 248 if (!defined $config{sambaUnixIdPooldn}) {
 249         $config{sambaUnixIdPooldn}="sambaDomainName=$config{sambaDomain},$config{suffix}";
 250 }
 251 if (!defined $config{masterLDAP}) {
 252         $config{masterLDAP}="127.0.0.1";
 253 }
 254 if (!defined $config{masterPort}) {
 255         $config{masterPort}="389";
 256 }
 257 if (!defined $config{slaveLDAP}) {
 258         $config{slaveLDAP}="127.0.0.1";
 259 }
 260 if (!defined $config{slavePort}) {
 261         $config{slavePort}="389";
 262 }
 263 if (!defined $config{ldapTLS}) {
 264         $config{ldapTLS}="0";
 265 }
 266
 267 sub connect_ldap_master
 268   {
 269         # bind to a directory with dn and password
 270         my $ldap_master = Net::LDAP->new(
 271                                                                          "$config{masterLDAP}",
 272                                                                          port => "$config{masterPort}",
 273                                                                          version => 3,
 274                                                                          timeout => 60,
 275                                                                          # debug => 0xffff,
 276                                                                         )
 277           or die "erreur LDAP: Can't contact master ldap server ($@)";
 278         if ($config{ldapTLS} == 1) {
 279           $ldap_master->start_tls(
 280                                                           verify => "$config{verify}",
 281                                                           clientcert => "$config{clientcert}",
 282                                                           clientkey => "$config{clientkey}",
 283                                                           cafile => "$config{cafile}"
 284                                                          );
 285         }
 286         $ldap_master->bind ( "$config{masterDN}",
 287                                                  password => "$config{masterPw}"
 288                                            );
 289         $ldap=$ldap_master;
 290         return($ldap_master);
 291   }
 292
 293 sub connect_ldap_slave
 294   {
 295         # bind to a directory with dn and password
 296         my $conf_cert;
 297         my $ldap_slave = Net::LDAP->new(
 298                                                                  "$config{slaveLDAP}",
 299                                                                  port => "$config{slavePort}",
 300                                                                  version => 3,
 301                                                                  timeout => 60,
 302                                                                  # debug => 0xffff,
 303                                                                 )
 304           or warn "erreur LDAP: Can't contact slave ldap server ($@)\n=>trying to contact the master server\n";
 305         if (!$ldap_slave) {
 306           # connection to the slave failed: trying to contact the master ...
 307           $ldap_slave = Net::LDAP->new(
 308                                                                    "$config{masterLDAP}",
 309                                                                    port => "$config{masterPort}",
 310                                                                    version => 3,
 311                                                                    timeout => 60,
 312                                                                    # debug => 0xffff,
 313                                                                   )
 314                 or die "erreur LDAP: Can't contact master ldap server ($@)\n";
 315         }
 316         if ($ldap_slave) {
 317           if ($config{ldapTLS} == 1) {
 318                 $ldap_slave->start_tls(
 319                                                            verify => "$config{verify}",
 320                                                            clientcert => "$config{clientcert}",
 321                                                            clientkey => "$config{clientkey}",
 322                                                            cafile => "$config{cafile}"
 323                                                           );
 324           }
 325           $ldap_slave->bind ( "$config{masterDN}",
 326                                                   password => "$config{masterPw}"
 327                                                 );
 328           $ldap=$ldap_slave;
 329           return($ldap_slave);
 330         }
 331   }
 332
 333 sub get_user_dn
 334   {
 335     my $user = shift;
 336     my $dn='';
 337     my  $mesg = $ldap->search (    base   => $config{suffix},
 338                                                                                  scope => $config{scope},
 339                                                                                  filter => "(&(objectclass=posixAccount)(uid=$user))"
 340                                                                         );
 341     $mesg->code && die $mesg->error;
 342     foreach my $entry ($mesg->all_entries) {
 343           $dn= $entry->dn;
 344         }
 345     chomp($dn);
 346     if ($dn eq '') {
 347           return undef;
 348     }
 349     $dn="dn: ".$dn;
 350     return $dn;
 351   }
 352
 353
 354 sub get_user_dn2
 355   {
 356     my $user = shift;
 357     my $dn='';
 358     my  $mesg = $ldap->search (    base   => $config{suffix},
 359                                                                                  scope => $config{scope},
 360                                                                                  filter => "(&(objectclass=posixAccount)(uid=$user))"
 361                                                                         );
 362     $mesg->code && warn "failed to perform search; ", $mesg->error;
 363
 364     foreach my $entry ($mesg->all_entries) {
 365           $dn= $entry->dn;
 366     }
 367     chomp($dn);
 368     if ($dn eq '') {
 369           return (1,undef);
 370     }
 371     $dn="dn: ".$dn;
 372     return (1,$dn);
 373   }
 374
 375
 376 sub get_group_dn
 377   {
 378         my $group = shift;
 379         my $dn='';
 380         my $filter;
 381         if ($group =~ /^\d+$/) {
 382           $filter="(&(objectclass=posixGroup)(|(cn=$group)(gidNumber=$group)))";
 383         } else {
 384           $filter="(&(objectclass=posixGroup)(cn=$group))";
 385         }
 386         my  $mesg = $ldap->search (    base   => $config{groupsdn},
 387                                                                                  scope => $config{scope},
 388                                                                                  filter => $filter
 389                                                                         );
 390         $mesg->code && die $mesg->error;
 391         foreach my $entry ($mesg->all_entries) {
 392           $dn= $entry->dn;
 393         }
 394         chomp($dn);
 395         if ($dn eq '') {
 396           return undef;
 397         }
 398         $dn="dn: ".$dn;
 399         return $dn;
 400   }
 401
 402 # return (success, dn)
 403 # bool = is_samba_user($username)
 404 sub is_samba_user
 405   {
 406         my $user = shift;
 407         my $mesg = $ldap->search (    base   => $config{suffix},
 408                                                                                 scope => $config{scope},
 409                                                                                 filter => "(&(objectClass=sambaSamAccount)(uid=$user))"
 410                                                                    );
 411         $mesg->code && die $mesg->error;
 412         return ($mesg->count ne 0);
 413   }
 414
 415 sub is_unix_user
 416   {
 417         my $user = shift;
 418         my $mesg = $ldap->search (    base   => $config{suffix},
 419                                                                                 scope => $config{scope},
 420                                                                                 filter => "(&(objectClass=posixAccount)(uid=$user))"
 421                                                                    );
 422         $mesg->code && die $mesg->error;
 423         return ($mesg->count ne 0);
 424   }
 425
 426 sub is_group_member
 427   {
 428         my $dn_group = shift;
 429         my $user = shift;
 430         my $mesg = $ldap->search (   base   => $dn_group,
 431                                                                            scope => 'base',
 432                                                                            filter => "(&(memberUid=$user))"
 433                                                                    );
 434         $mesg->code && die $mesg->error;
 435         return ($mesg->count ne 0);
 436   }
 437
 438 # all entries = does_sid_exist($sid,$config{scope})
 439 sub does_sid_exist
 440   {
 441         my $sid = shift;
 442         my $dn_group=shift;
 443         my $mesg = $ldap->search (    base   => $dn_group,
 444                                                                                 scope => $config{scope},
 445                                                                                 filter => "(sambaSID=$sid)"
 446                                                                                 #filter => "(&(objectClass=sambaSAMAccount|objectClass=sambaGroupMapping)(sambaSID=$sid))"
 447                                                                    );
 448         $mesg->code && die $mesg->error;
 449         return ($mesg);
 450   }
 451
 452 # try to bind with user dn and password to validate current password
 453 sub is_user_valid
 454   {
 455         my ($user, $dn, $pass) = @_;
 456         my $userLdap = Net::LDAP->new($config{slaveLDAP}) or die "erreur LDAP";
 457         my $mesg= $userLdap->bind (dn => $dn, password => $pass );
 458         if ($mesg->code eq 0) {
 459           $userLdap->unbind;
 460           return 1;
 461         } else {
 462           if ($userLdap->bind()) {
 463                 $userLdap->unbind;
 464                 return 0;
 465           } else {
 466                 print ("The LDAP directory is not available.\n Check the server, cables ...");
 467                 $userLdap->unbind;
 468                 return 0;
 469           }
 470           die "Problem : contact your administrator";
 471         }
 472   }
 473
 474
 475 # dn = get_dn_from_line ($dn_line)
 476 # helper to get "a=b,c=d" from "dn: a=b,c=d"
 477 sub get_dn_from_line
 478   {
 479         my $dn = shift;
 480         $dn =~ s/^dn: //;
 481         return $dn;
 482   }
 483
 484
 485 # success = add_posix_machine($user, $uid, $gid)
 486 sub add_posix_machine
 487   {
 488         my ($user,$uid,$gid,$wait) = @_;
 489         if (!defined $wait) {
 490                 $wait=0;
 491         }
 492         # bind to a directory with dn and password
 493         my $add = $ldap->add ( "uid=$user,$config{computersdn}",
 494                                                                   attr => [
 495                                                                                    'objectclass' => ['top','inetOrgPerson', 'posixAccount'],
 496                                                                                    'cn'   => "$user",
 497                                                                                    'sn'   => "$user",
 498                                                                                    'uid'   => "$user",
 499                                                                                    'uidNumber'   => "$uid",
 500                                                                                    'gidNumber'   => "$gid",
 501                                                                                    'homeDirectory'   => '/dev/null',
 502                                                                                    'loginShell'   => '/bin/false',
 503                                                                                    'description'   => 'Computer',
 504                                                                                   'gecos'   => 'Computer',
 505                                                                                   ]
 506                                                                 );
 507
 508         $add->code && warn "failed to add entry: ", $add->error ;
 509         sleep($wait);
 510         return 1;
 511   }
 512
 513
 514 # success = add_samba_machine_smbpasswd($computername)
 515 sub add_samba_machine_smbpasswd
 516   {
 517     my $user = shift;
 518     system "smbpasswd -a -m $user";
 519     return 1;
 520   }
 521
 522 sub add_samba_machine
 523   {
 524         my ($user, $uid) = @_;
 525         my $sambaSID = 2 * $uid + 1000;
 526         my $name = $user;
 527         $name =~ s/.$//s;
 528
 529         my ($lmpassword,$ntpassword) = ntlmgen $name;
 530         my $modify = $ldap->modify ( "uid=$user,$config{computersdn}",
 531                                                                                 changes => [
 532                                                                                                         replace => [objectClass => ['inetOrgPerson', 'posixAccount', 'sambaSAMAccount']],
 533                                                                                                         add => [sambaPwdLastSet => '0'],
 534                                                                                                         add => [sambaLogonTime => '0'],
 535                                                                                                         add => [sambaLogoffTime => '2147483647'],
 536                                                                                                         add => [sambaKickoffTime => '2147483647'],
 537                                                                                                         add => [sambaPwdCanChange => '0'],
 538                                                                                                         add => [sambaPwdMustChange => '0'],
 539                                                                                                         add => [sambaAcctFlags => '[W          ]'],
 540                                                                                                         add => [sambaLMPassword => "$lmpassword"],
 541                                                                                                         add => [sambaNTPassword => "$ntpassword"],
 542                                                                                                         add => [sambaSID => "$config{SID}-$sambaSID"],
 543                                                                                                         add => [sambaPrimaryGroupSID => "$config{SID}-0"]
 544                                                                                                    ]
 545                                                                           );
 546
 547         $modify->code && die "failed to add entry: ", $modify->error ;
 548
 549         return 1;
 550   }
 551
 552 sub group_add_user
 553   {
 554         my ($group, $userid) = @_;
 555         my $members='';
 556         my $dn_line = get_group_dn($group);
 557         if (!defined(get_group_dn($group))) {
 558           print "$0: group \"$group\" doesn't exist\n";
 559           exit (6);
 560         }
 561         if (!defined($dn_line)) {
 562           return 1;
 563         }
 564         my $dn = get_dn_from_line("$dn_line");
 565         # on look if the user is already present in the group
 566         my $is_member=is_group_member($dn,$userid);
 567         if ($is_member == 1) {
 568           print "User \"$userid\" already member of the group \"$group\".\n";
 569         } else {
 570           # bind to a directory with dn and password
 571           # It does not matter if the user already exist, Net::LDAP will add the user
 572           # if he does not exist, and ignore him if his already in the directory.
 573           my $modify = $ldap->modify ( "$dn",
 574                                                                                   changes => [
 575                                                                                                           add => [memberUid => $userid]
 576                                                                                                          ]
 577                                                                                 );
 578           $modify->code && die "failed to modify entry: ", $modify->error ;
 579         }
 580   }
 581
 582 sub group_del
 583   {
 584         my $group_dn=shift;
 585         # bind to a directory with dn and password
 586         my $modify = $ldap->delete ($group_dn);
 587         $modify->code && die "failed to delete group : ", $modify->error ;
 588   }
 589
 590 sub add_grouplist_user
 591   {
 592         my ($grouplist, $user) = @_;
 593         my @array = split(/,/, $grouplist);
 594         foreach my $group (@array) {
 595           group_add_user($group, $user);
 596         }
 597   }
 598
 599 sub disable_user
 600   {
 601         my $user = shift;
 602         my $dn_line;
 603         my $dn = get_dn_from_line($dn_line);
 604
 605         if (!defined($dn_line = get_user_dn($user))) {
 606           print "$0: user $user doesn't exist\n";
 607           exit (10);
 608         }
 609         my $modify = $ldap->modify ( "$dn",
 610                                                                                 changes => [
 611                                                                                                         replace => [userPassword => '{crypt}!x']
 612                                                                                                    ]
 613                                                                           );
 614         $modify->code && die "failed to modify entry: ", $modify->error ;
 615
 616         if (is_samba_user($user)) {
 617           my $modify = $ldap->modify ( "$dn",
 618                                                                                   changes => [
 619                                                                                                           replace => [sambaAcctFlags => '[D       ]']
 620                                                                                                          ]
 621                                                                                 );
 622           $modify->code && die "failed to modify entry: ", $modify->error ;
 623         }
 624   }
 625
 626 # delete_user($user)
 627 sub delete_user
 628   {
 629         my $user = shift;
 630         my $dn_line;
 631
 632         if (!defined($dn_line = get_user_dn($user))) {
 633           print "$0: user $user doesn't exist\n";
 634           exit (10);
 635         }
 636
 637         my $dn = get_dn_from_line($dn_line);
 638         my $modify = $ldap->delete($dn);
 639   }
 640
 641 # $gid = group_add($groupname, $group_gid, $force_using_existing_gid)
 642 sub group_add
 643   {
 644         my ($gname, $gid, $force) = @_;
 645         my $nscd_status = system "/etc/init.d/nscd status >/dev/null 2>&1";
 646         if ($nscd_status == 0) {
 647           system "/etc/init.d/nscd stop > /dev/null 2>&1";
 648         }
 649         if (!defined($gid)) {
 650           #while (defined(getgrgid($config{GID_START}))) {
 651           #     $config{GID_START}++;
 652           #}
 653           #$gid = $config{GID_START};
 654           $gid=get_next_id($config{groupsdn},"gidNumber");
 655         } else {
 656           if (!defined($force)) {
 657                 if (defined(getgrgid($gid))) {
 658                   return undef;
 659                 }
 660           }
 661         }
 662         if ($nscd_status == 0) {
 663           system "/etc/init.d/nscd start > /dev/null 2>&1";
 664         }
 665         my $modify = $ldap->add ( "cn=$gname,$config{groupsdn}",
 666                                                                          attrs => [
 667                                                                                            objectClass => 'posixGroup',
 668                                                                                            cn => "$gname",
 669                                                                                            gidNumber => "$gid"
 670                                                                                           ]
 671                                                                    );
 672
 673         $modify->code && die "failed to add entry: ", $modify->error ;
 674         return $gid;
 675   }
 676
 677 # $homedir = get_homedir ($user)
 678 sub get_homedir
 679   {
 680         my $user = shift;
 681         my $homeDir='';
 682         my $entry;
 683         my  $mesg = $ldap->search (
 684                                                                          base   =>$config{usersdn},
 685                                                                          scope => $config{scope},
 686                                                                          filter => "(&(objectclass=posixAccount)(uid=$user))"
 687                                                                         );
 688         $mesg->code && die $mesg->error;
 689
 690         my $nb=$mesg->count;
 691         if ($nb > 1) {
 692           print "Aborting: there are $nb existing user named $user\n";
 693           foreach $entry ($mesg->all_entries) {
 694                 my $dn=$entry->dn;
 695                 print "  $dn\n";
 696           }
 697           exit (4);
 698         } else {
 699           $entry = $mesg->shift_entry();
 700           $homeDir= $entry->get_value("homeDirectory");
 701         }
 702
 703         chomp $homeDir;
 704         if ($homeDir eq '') {
 705           return undef;
 706         }
 707         return $homeDir;
 708   }
 709
 710 # search for an user
 711 sub read_user
 712   {
 713         my $user = shift;
 714         my $lines ='';
 715         my $mesg = $ldap->search ( # perform a search
 716                                                                         base   => $config{suffix},
 717                                                                         scope => $config{scope},
 718                                                                         filter => "(&(objectclass=posixAccount)(uid=$user))"
 719                                                                    );
 720
 721         $mesg->code && die $mesg->error;
 722         foreach my $entry ($mesg->all_entries) {
 723           $lines.= "dn: " . $entry->dn."\n";
 724           foreach my $attr ($entry->attributes) {
 725                 {
 726                   $lines.= $attr.": ".join(',', $entry->get_value($attr))."\n";
 727                 }
 728           }
 729         }
 730         chomp $lines;
 731         if ($lines eq '') {
 732           return undef;
 733         }
 734         return $lines;
 735   }
 736
 737 # search for a user
 738 # return the attributes in an array
 739 sub read_user_entry
 740   {
 741         my $user = shift;
 742         my  $mesg = $ldap->search ( # perform a search
 743                                                                          base   => $config{suffix},
 744                                                                          scope => $config{scope},
 745                                                                          filter => "(&(objectclass=posixAccount)(uid=$user))"
 746                                                                         );
 747
 748         $mesg->code && die $mesg->error;
 749         my $entry = $mesg->entry();
 750         return $entry;
 751   }
 752
 753 # search for a group
 754 sub read_group
 755   {
 756         my $user = shift;
 757         my $lines ='';
 758         my  $mesg = $ldap->search ( # perform a search
 759                                                                          base   => $config{groupsdn},
 760                                                                          scope => $config{scope},
 761                                                                          filter => "(&(objectclass=posixGroup)(cn=$user))"
 762                                                                         );
 763
 764         $mesg->code && die $mesg->error;
 765         foreach my $entry ($mesg->all_entries) {
 766           $lines.= "dn: " . $entry->dn."\n";
 767           foreach my $attr ($entry->attributes) {
 768                 {
 769                   $lines.= $attr.": ".join(',', $entry->get_value($attr))."\n";
 770                 }
 771           }
 772         }
 773         chomp $lines;
 774         if ($lines eq '') {
 775           return undef;
 776         }
 777         return $lines;
 778   }
 779
 780 # find groups of a given user
 781 ##### MODIFIE ########
 782 sub find_groups_of {
 783   my $user = shift;
 784   my @groups = ();
 785   my $mesg = $ldap->search ( # perform a search
 786                                   base   => $config{groupsdn},
 787                                   scope => $config{scope},
 788                                   filter => "(&(objectclass=posixGroup)(memberuid=$user))"
 789                                  );
 790   $mesg->code && die $mesg->error;
 791
 792   my $entry;
 793   while ($entry = $mesg->shift_entry()) {
 794     push(@groups, scalar($entry->get_value('cn')));
 795   }
 796   return (@groups);
 797 }
 798
 799 sub read_group_entry {
 800   my $group = shift;
 801   my $entry;
 802   my %res;
 803   my  $mesg = $ldap->search ( # perform a search
 804                                                                    base   => $config{groupsdn},
 805                                                                    scope => $config{scope},
 806                                                                    filter => "(&(objectclass=posixGroup)(cn=$group))"
 807                                                                   );
 808
 809   $mesg->code && die $mesg->error;
 810   my $nb=$mesg->count;
 811   if ($nb > 1) {
 812     print "Error: $nb groups exist \"cn=$group\"\n";
 813     foreach $entry ($mesg->all_entries) {
 814           my $dn=$entry->dn; print "  $dn\n";
 815         }
 816     exit 11;
 817   } else {
 818     $entry = $mesg->shift_entry();
 819   }
 820   return $entry;
 821 }
 822
 823 sub read_group_entry_gid {
 824   my $group = shift;
 825   my %res;
 826   my  $mesg = $ldap->search ( # perform a search
 827                                                                    base   => $config{groupsdn},
 828                                                                    scope => $config{scope},
 829                                                                    filter => "(&(objectclass=posixGroup)(gidNumber=$group))"
 830                                                                   );
 831
 832   $mesg->code && die $mesg->error;
 833   my $entry = $mesg->shift_entry();
 834   return $entry;
 835 }
 836
 837 # return the gidnumber for a group given as name or gid
 838 # -1 : bad group name
 839 # -2 : bad gidnumber
 840 sub parse_group
 841   {
 842         my $userGidNumber = shift;
 843         if ($userGidNumber =~ /[^\d]/ ) {
 844           my $gname = $userGidNumber;
 845           my $gidnum = getgrnam($gname);
 846           if ($gidnum !~ /\d+/) {
 847                 return -1;
 848           } else {
 849                 $userGidNumber = $gidnum;
 850           }
 851         } elsif (!defined(getgrgid($userGidNumber))) {
 852           return -2;
 853         }
 854         return $userGidNumber;
 855   }
 856
 857 # remove $user from $group
 858 sub group_remove_member
 859   {
 860         my ($group, $user) = @_;
 861         my $members='';
 862         my $grp_line = get_group_dn($group);
 863         if (!defined($grp_line)) {
 864           return 0;
 865         }
 866         my $dn = get_dn_from_line($grp_line);
 867         # we test if the user exist in the group
 868         my $is_member=is_group_member($dn,$user);
 869         if ($is_member == 1) {
 870           # delete only the user from the group
 871           my $modify = $ldap->modify ( "$dn",
 872                                                                                   changes => [
 873                                                                                                           delete => [memberUid => ["$user"]]
 874                                                                                                          ]
 875                                                                                 );
 876           $modify->code && die "failed to delete entry: ", $modify->error ;
 877         }
 878         return 1;
 879   }
 880
 881 sub group_get_members
 882   {
 883         my ($group) = @_;
 884         my $members;
 885         my @resultat;
 886         my $grp_line = get_group_dn($group);
 887         if (!defined($grp_line)) {
 888           return 0;
 889         }
 890         my  $mesg = $ldap->search (
 891                                                            base   => $config{groupsdn},
 892                                                            scope => $config{scope},
 893                                                            filter => "(&(objectclass=posixgroup)(cn=$group))"
 894                                                           );
 895         $mesg->code && die $mesg->error;
 896         foreach my $entry ($mesg->all_entries) {
 897           foreach my $attr ($entry->attributes) {
 898                 if ($attr=~/\bmemberUid\b/) {
 899                   foreach my $ent ($entry->get_value($attr)) {
 900                         push (@resultat,$ent);
 901                   }
 902                 }
 903           }
 904         }
 905         return @resultat;
 906   }
 907
 908 sub do_ldapmodify
 909   {
 910         my $ldif = shift;
 911         my $FILE = "|$config{ldapmodify} -r >/dev/null";
 912         open (FILE, $FILE) || die "$!\n";
 913         print FILE <<EOF;
 914 $ldif
 915 EOF
 916         ;
 917         close FILE;
 918         my $rc = $?;
 919         return $rc;
 920   }
 921
 922 sub group_type_by_name {
 923   my $type_name = shift;
 924   my %groupmap = (
 925                                   'domain' => 2,
 926                                   'local' => 4,
 927                                   'builtin' => 5
 928                                  );
 929   return $groupmap{$type_name};
 930 }
 931
 932 sub subst_user
 933   {
 934         my ($str, $username) = @_;
 935         $str =~ s/%U/$username/ if ($str);
 936         return($str);
 937   }
 938
 939 # all given mails are stored in a table (remove the comma separated)
 940 sub split_arg_comma {
 941   my $arg = shift;
 942   my @args;
 943   if (defined($arg)) {
 944     if ($arg eq '-') {
 945       @args = ( );
 946     } else {
 947       @args = split(/\s*,\s*/, $arg);
 948     }
 949   }
 950   return (@args);
 951 }
 952
 953 sub list_union {
 954   my ($list1, $list2) = @_;
 955   my @res = @$list1;
 956   foreach my $e (@$list2) {
 957     if (! grep($_ eq $e, @$list1)) {
 958       push(@res, $e);
 959     }
 960   }
 961   return @res;
 962 }
 963
 964 sub list_minus {
 965   my ($list1, $list2) = @_;
 966   my @res = ();
 967   foreach my $e (@$list1) {
 968     if (! grep( $_ eq $e, @$list2 )) {
 969       push(@res, $e);
 970     }
 971   }
 972   return @res;
 973 }
 974
 975 sub get_next_id($$) {
 976   my $ldap_base_dn = shift;
 977   my $attribute = shift;
 978   my $tries = 0;
 979   my $found=0;
 980   my $next_uid_mesg;
 981   my $nextuid;
 982   if ($ldap_base_dn =~ m/$config{usersdn}/i) {
 983         # when adding a new user, we'll check if the uidNumber available is not
 984         # already used for a computer's account
 985         $ldap_base_dn=$config{suffix}
 986   }
 987   do {
 988         $next_uid_mesg = $ldap->search(
 989                                                                                   base => $config{sambaUnixIdPooldn},
 990                                                                                   filter => "(objectClass=sambaUnixIdPool)",
 991                                                                                   scope => "base"
 992                                                                                  );
 993         $next_uid_mesg->code && die "Error looking for next uid";
 994         if ($next_uid_mesg->count != 1) {
 995           die "Could not find base dn, to get next $attribute";
 996         }
 997         my $entry = $next_uid_mesg->entry(0);
 998
 999         $nextuid = $entry->get_value($attribute);
1000         my $modify=$ldap->modify( "$config{sambaUnixIdPooldn}",
1001                                                                          changes => [
1002                                                                                                  replace => [ $attribute => $nextuid + 1 ]
1003                                                                                                 ]
1004                                                                    );
1005         $modify->code && die "Error: ", $modify->error;
1006         # let's check if the id found is really free (in ou=Groups or ou=Users)...
1007         my $check_uid_mesg = $ldap->search(
1008                                                                                           base => $ldap_base_dn,
1009                                                                                           filter => "($attribute=$nextuid)",
1010                                                                                          );
1011         $check_uid_mesg->code && die "Cannot confirm $attribute $nextuid is free";
1012         if ($check_uid_mesg->count == 0) {
1013           $found=1;
1014           return $nextuid;
1015         }
1016         $tries++;
1017         print "Cannot confirm $attribute $nextuid is free: checking for the next one\n"
1018   } while ($found != 1);
1019   die "Could not allocate $attribute!";
1020 }
1021
1022 1;
1023