1: <p>
   2: Copyright (c) 1999-2001, Keith S. Chea. All rights reserved. 
   3: </p><p>
   4: Legal Note: codes you see below were extracted
   5: from my soon-to-be-released product and they
   6: are copyrighted. These codes (and soon-to-be
   7: released product) is free, you can redistribute
   8: it and/or modify it as long the copyright note
   9: (above) remains intact. Using these codes for 
  10: commercial purposes without prior permission 
  11: from me is prohibited. 
  12: </p>
  13: <p>
  14: Works the same as "dbmmanage add|adduser", except 
  15: that you can add group(s) to an existing user, 
  16: and remove any duplicated group(s) before adding.
  17: </p>
  18: <code>
  19: #!/usr/local/bin/perl
  20: 
  21: use strict;
  22: use DB_File;
  23: my $u = $ARGV[0] || 'japh'; #User ID: i.e japh
  24: my $p = $ARGV[1] || '1234'; #Password: i.e 1234
  25: my $g = $ARGV[2] || 'perl'; #Group: i.e admin or admin,staff,root
  26: my @o = ("email\@yahoo.com", "123 St,Boston,MA 02450,USA","24","Male"); #optionally other information
  27: &_($u,$p,$g);
  28: 
  29: sub _{ my($u1,$p1,$g1,@o1)=@_;
  30:        my(%D)=();
  31:        my(%G)=();
  32:        my(@G,@V,@U,@M);
  33: 
  34:        flock "pwd.db",2;dbmopen %D,"pwd.db", 0666 or die "$!\n";while(
  35: 
  36:        my($k,$v) = each %D){$D{$k} = $v;}
  37:        my($o) = defined(@o1) ? join ',',@o1 : '';
  38:        my($g) = ($g1 =~ /[^\w\-\,]+/) ? undef : $g1;
  39:        my($p) = sub {shift;
  40:        my(@__)= ('.','/','A'..'Z','a'..'z','0'..'9');
  41:        my($s) = $__[rand($#__) + 0] . $__[rand($#__) + 0];
  42:        my($c) = crypt($_,$s);};@G = grep {! $G{$_} ++ } split ',',$g1;
  43: 
  44:        if(exists $D{$u1}){
  45:        if(defined $g){@V = split ':',$D{$u1};
  46:        if($V[1] ne ''){@M
  47:  
  48:        = (@G,(split ',',$V[1]));@U 
  49:        = grep {! $G{$_} ++ } @M;$V[1] 
  50:        = join ',',@U,@G;$D{$u1} 
  51:        = join ':',$V[0],$V[1],$V[2];
  52:             
  53:        }else{$V[1] = join ',',@G;$D{$u1} = join ':',$V[0],$V[1],$V[2];}
  54:        }else{dbmclose %D;flock "pwd.db", 8;print "$u1 existed\n";exit(0);}
  55:        }else{$D{$u1} = join ':',&$p($p),(join ',',@G),$o;}dbmclose %D;
  56: 
  57:        flock "pwd.db", 8;
  58:        my($z) = sub {dbmopen %D, "pwd.db", 0444 or die "$!\n";while(
  59:        my($x,$y) = each %D){return "$x:$y\n";}dbmclose %D;};print &$z;
  60:     } 
  61: </CODE>
  62: <small><strong>Edit</strong> [kudra], 
  63: 2001-07-25
  64: Changed formatting--HTML not code ;)
  65: </small>
  66: </p>