r12417 - in /branches/upstream/liblinux-usermod-perl: ./ current/ current/Makefile.PL current/README current/t/ current/t/main.t current/usermod.pm current/usrm
mogaal-guest at users.alioth.debian.org
mogaal-guest at users.alioth.debian.org
Thu Jan 10 10:56:01 UTC 2008
Author: mogaal-guest
Date: Thu Jan 10 10:56:01 2008
New Revision: 12417
URL: http://svn.debian.org/wsvn/?sc=1&rev=12417
Log:
[svn-inject] Installing original source of liblinux-usermod-perl
Added:
branches/upstream/liblinux-usermod-perl/
branches/upstream/liblinux-usermod-perl/current/
branches/upstream/liblinux-usermod-perl/current/Makefile.PL
branches/upstream/liblinux-usermod-perl/current/README
branches/upstream/liblinux-usermod-perl/current/t/
branches/upstream/liblinux-usermod-perl/current/t/main.t
branches/upstream/liblinux-usermod-perl/current/usermod.pm
branches/upstream/liblinux-usermod-perl/current/usrm (with props)
Added: branches/upstream/liblinux-usermod-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/liblinux-usermod-perl/current/Makefile.PL?rev=12417&op=file
==============================================================================
--- branches/upstream/liblinux-usermod-perl/current/Makefile.PL (added)
+++ branches/upstream/liblinux-usermod-perl/current/Makefile.PL Thu Jan 10 10:56:01 2008
@@ -1,0 +1,11 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'Linux::usermod',
+ 'VERSION_FROM' => 'usermod.pm', # finds $VERSION
+ 'PREREQ_PM' => {
+ 'Carp' => 0,
+ 'Test' => 0
+ }
+);
Added: branches/upstream/liblinux-usermod-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/liblinux-usermod-perl/current/README?rev=12417&op=file
==============================================================================
--- branches/upstream/liblinux-usermod-perl/current/README (added)
+++ branches/upstream/liblinux-usermod-perl/current/README Thu Jan 10 10:56:01 2008
@@ -1,0 +1,170 @@
+NAME
+ Linux::usermod - modify user and group accounts
+
+SYNOPSIS
+ use Linux::usermod;
+
+ $user = Linux::usermod->new(username);
+ $grp = Linux::usermod->new(groupname, 1);
+
+ $user->get(gid); # equal to $user->get(3);
+ $user->get(uid); # equal to $user->get(2);
+ $grp->get(gid); # equal to $user->get(2);
+ $grp->get(users);# equal to $user->get(3);
+
+ #lock and unlock user account
+
+ $user->lock();
+ $user->unlock();
+
+ #get password(passwd file)
+ $user->get(ppassword);
+
+ #get encoded password(shadow file)
+ $user->get(password);
+
+ #set encoded password
+ $user->set(password);
+ $grp->set(password);
+
+ #set shell / group administrator
+ $user->set(shell);
+ $grp->set(ga);
+
+ #set group users
+ @users = wq(user1 user2);
+ $grp->set(users, \@users);
+
+ Linux::usermod->add(username);
+
+ #or
+
+ Linux::usermod->add(username, password, uid, gid, comment, home, shell);
+
+ #where the password goes in shadow file and gid becomes
+ #equal to uid unless specified and uid is becoming the
+ #first unreserved number after 1000 unless specified
+
+ #or
+
+ @users = qw(user1 user2 user3);
+ Linux::usermod->grpadd(groupname, gid, "@users")
+
+ #where the password goes in gshadow file and gid becomes
+ #equal to the second argument or the first unreserved number
+ #after 100
+
+ #delete user/group
+ Linux::usermod->del(username);
+ Linux::usermod->grpdel(groupname);
+
+ #all fields are returned from the class methods fields/gfields
+ print $user->get($_) for (Linux::usermod->fields);
+ print $grp->get($_) for (Linux::usermod->gfields);
+
+ #set working passwd and shadow files
+
+ #$Linux::usermod::file_passwd = "./my_passwd";
+ #$Linux::usermod::file_shadow = "./my_shadow";
+ #$Linux::usermod::file_group = "./my_group";
+ #$Linux::usermod::file_gshadow= "./my_gshadow";
+
+DESCRIPTION
+ This module adds, removes and modify user and group accounts according
+ to the passwd and shadow files syntax (like struct passwd from pwd.h).
+ It is not necessary those accounts to be system as long as
+ $Linux::usermod::file_passwd, $Linux::usermod::file_shadow,
+ $Linux::usermod::file_group, $Linux::usermod::file_gshadow are not in
+ "/etc" directory.
+
+METHODS
+ new
+ Linux::usermod->new(username)
+ Linux::usermod->new(grpname, 1)
+
+ If group object second 'true' argument must be given
+
+ add (username, ...) Class method - add new user account; arguments
+ are optional, except username; they may be (username, password,
+ uid, gid, comment, home, shell)
+
+ del (username) Class method - removes user account
+
+ tobsd converts user fields in shadow / master.passwd file to bsd style
+
+ get if used with user object returns one of the following fields:
+
+ 'name' or 0 The user's name
+ 'ppassword' or 1 The "passwd" file password
+ 'uid' or 2 The user's id
+ 'gid' or 3 The user's group id
+ 'comment' or 4 The comment about the user (real username)
+ 'home' or 5 The user's home directory
+ 'shell' or 6 The user's shell
+ 'sname' or 7 The user's name in shadow file
+ 'password' or 8 The 13-character encoded password
+ 'lastchg' or 9 The number of days since January 1, 1970 of the last password changed date
+ 'min' or 10 The minimum number of days required between password changes
+ 'max' or 11 The maximum number of days the password is valid
+ 'warn' or 12 The number of days before expiring the password that the user is warned
+ 'inactive' or 13 The number of days of inactivity allowed for the user
+ 'expire' or 14 The number of days since January 1, 1970 that account is disabled
+ 'flag' or 15 Currently not used
+
+ if used with group object returns one of the following fields:
+
+ 'name' or 0 The group name
+ 'ppassword' or 1 The group password
+ 'gid' or 2 The group id number
+ 'users' or 3 The group members (users)
+ 'sname' or 4 The group name in gshadow file (the same as 'name')
+ 'password' or 5 The encrypted group password
+ 'ga' or 6 The group administrators
+ 'gu' or 7 The group members (users) (the same as 'users')
+
+ argument can be either string or number
+
+ set (field)
+
+ seet a field which must be string of characters: keys %fields
+ for user object keys %gfields for group object
+
+ grpadd (groupname)
+
+ grpdel (groupname)
+
+ lock (username) Lock user account (puts '!' at the beginning of the
+ encoded password)
+
+ unlock (username) Unlock user account (removes '!' from the beginning
+ of the encoded password)
+
+ users Class method - return hash which keys are all users, taken from
+ $file_passwd
+
+ grps Class method - return hash which keys are all groups, taken from
+ $file_group
+
+FILES
+ /etc/passwd /etc/shadow /etc/group /etc/gshadow
+
+ unless given your own passwd, shadow, group, gshadow files which must be
+ created
+
+TO DO
+ Groups and user accounts consistency checks
+
+SEE ALSO
+ getpwent(3), getpwnam(3), usermod(8), passwd(1), gpasswd(1)
+
+BUGS
+ None known. Report any to author.
+
+AUTHOR
+ Vidul Petrov, vidul at abv.bg
+
+ © 2004 Vidul Petrov. All rights reserved.
+
+ This library is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.
+
Added: branches/upstream/liblinux-usermod-perl/current/t/main.t
URL: http://svn.debian.org/wsvn/branches/upstream/liblinux-usermod-perl/current/t/main.t?rev=12417&op=file
==============================================================================
--- branches/upstream/liblinux-usermod-perl/current/t/main.t (added)
+++ branches/upstream/liblinux-usermod-perl/current/t/main.t Thu Jan 10 10:56:01 2008
@@ -1,0 +1,52 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 10 }
+
+use Linux::usermod;
+
+my $passwd = "t/passwd";
+my $shadow = "t/shadow";
+my $group = "t/group";
+my $gshadow = "t/gshadow";
+my $user = "tester";
+my $uid = "65000";
+my $gid = "65000";
+my $comment = "tester account";
+my $home = "./";
+my $shell = "/dev/null";
+my $gname = "noones";
+my $users = $user;
+my $gadm = $user;
+
+open FH, ">$passwd" or die "can't open $passwd"; close FH;
+open FH, ">$shadow" or die "can't open $shadow"; close FH;
+open FH, ">$group" or die "can't open $group"; close FH;
+open FH, ">$gshadow" or die "can't open $gshadow"; close FH;
+
+$Linux::usermod::file_passwd = $passwd;
+$Linux::usermod::file_shadow = $shadow;
+$Linux::usermod::file_group = $group;
+$Linux::usermod::file_gshadow = $gshadow;
+
+Linux::usermod->add($user, "", $uid, $gid, $comment, $home, $shell);
+
+Linux::usermod->grpadd($gname, $gid, $users);
+
+my $tester = Linux::usermod->new($user);
+my $grp = Linux::usermod->new($gname, 1);
+
+$grp->set("ga", $gadm);
+
+ok($tester) or warn "user object creation failed\n";
+ok($user, $tester->get("name")) or warn "\tuser name field unrecognized\n";
+ok($uid, $tester->get("uid")) or warn "\tuid field unrecognized\n";
+ok($gid, $tester->get("gid")) or warn "\tgid field unrecognized\n";
+ok($comment, $tester->get("comment")) or warn "\tcomment field unrecognized\n";
+ok($home, $tester->get("home")) or warn "\thome field unrecognized\n";
+ok($shell, $tester->get("shell")) or warn "\tshell field unrecognized\n";
+ok($gname, $grp->get("name")) or warn "\tgroup name field unrecognized\n";
+ok($users, $grp->get("users")) or warn "\tgroup users field unrecognized\n";
+ok($gadm, $grp->get("ga")) or warn "\tgroup administrator field unrecognized\n";
+
+for($passwd, $shadow, $group, $gshadow){ unlink $_ }
Added: branches/upstream/liblinux-usermod-perl/current/usermod.pm
URL: http://svn.debian.org/wsvn/branches/upstream/liblinux-usermod-perl/current/usermod.pm?rev=12417&op=file
==============================================================================
--- branches/upstream/liblinux-usermod-perl/current/usermod.pm (added)
+++ branches/upstream/liblinux-usermod-perl/current/usermod.pm Thu Jan 10 10:56:01 2008
@@ -1,0 +1,771 @@
+package Linux::usermod;
+
+use strict;
+use Carp;
+use Fcntl ':flock';
+use vars qw($VERSION);
+$VERSION = 0.69;
+
+our $file_passwd = '/etc/passwd';
+our $file_shadow = '/etc/shadow';
+our $file_group = '/etc/group';
+our $file_gshadow = '/etc/gshadow';
+
+my %field = (
+ NAME => 0, #The user's name
+ PPASSWORD=> 1, #The "passwd" file password
+ UID => 2, #The user's id
+ GID => 3, #The user's group id
+ COMMENT => 4, #The comment about the user
+ HOME => 5, #The user's home directory
+ SHELL => 6, #The user's shell
+ SNAME => 7, #The user's name in shadow file
+ PASSWORD => 8, #The 13-character encrypted password
+ LASTCHG => 9, #The number of days since January 1, 1970 of the last password changed date
+ MIN => 10, #The minimum number of days required between password changes
+ MAX => 11, #The maximum number of days the password is valid
+ WARN => 12, #The number of days before expiring the password that the user is warned
+ INACTIVE => 13, #The number of days of inactivity allowed for the user
+ EXPIRE => 14, #The number of days since January 1, 1970 that account is disabled
+ FLAG => 15 #Currently not used.
+);
+
+my %gfield = (
+ NAME => 0, #The group name
+ PPASSWORD=> 1, #The group password
+ GID => 2, #The group id number
+ USERS => 3, #The group members (users)
+ SNAME => 4, #The group name in gshadow file
+ PASSWORD => 5, #The encrypted ggroup password
+ GA => 6, #The group administrators
+ GU => 7 #The group members (users)
+);
+
+sub fields { keys %field }
+
+sub gfields { keys %gfield }
+
+sub new {
+ my $class = shift;
+ my $user = shift;
+ my $flag = shift;
+ my @args;
+ if ($flag){
+ croak "no such group" unless _exists($user, $flag);
+ @args = _read_grp($user);
+ push @args, '__G__';
+ }else{
+ croak "no such user" unless _exists($user, $flag);
+ @args = _read_user($user);
+ push @args, '__U__';
+ }
+ return bless [ @args ], ref($class)||$class;
+}
+
+sub get {
+ my $self = shift;
+ my $what = shift;
+ my $key;
+ if($self->[-1] eq '__U__'){
+ if($what =~ /^\d{1,2}$/){
+ while(my($k, $v) = each %field){
+ $v == $what and $key = $k
+ }
+ return $self->[$field{$key}]
+ }
+ $what = uc $what;
+ return $self->[$field{$what}]
+ }
+ elsif($self->[-1] eq '__G__'){
+ if($what =~ /^\d{1,2}$/){
+ while(my($k, $v) = each %gfield){
+ $v == $what and $key = $k
+ }
+ return $self->[$gfield{$key}]
+ }
+ $what = uc $what;
+ return $self->[$gfield{$what}]
+ }
+}
+
+sub set {
+ my $self = shift;
+ my $what = shift;
+ my $newval = shift;
+ $what = uc $what;
+ return 0 unless exists($field{$what}) or exists($gfield{$what});
+ return 0 if $newval =~ /:/ and ($field{$what} != 8 or $gfield{$what} != 4);
+ $newval = '' if $newval =~ /^undef$/i;
+ if($self->[-1] eq '__U__'){
+ my $flag = shift || 0;
+ my $oldval = $self->[$field{$what}];
+ my $name = $self->[$field{NAME}];
+ _clean($name);
+ $self->[$field{$what}] = $newval;
+ if($field{$what} <= 6){
+ my @file = _io("$file_passwd", '', 'r');
+ my @user;
+ push @user, $self->[$_] for 0..6;
+ my $user = join ':', @user;
+ for(@file){ s/.+/$user/ if /^\Q$name\E:/ }
+ _io("$file_passwd", \@file, 'w');
+ if($field{$what} == 0){
+ croak "invalid name" if $newval !~ /^([A-Z]|[a-z]){1}\w{0,254}/;
+ my %names;
+ @file = @user = ();
+ @file = _io("$file_shadow", '', 'r');
+ map{ /^(.[^:]+):/ and $names{$1} = 1 }@file;
+ croak "user name $newval already exists" if defined($names{$newval});
+ undef %names;
+ push @user, $self->[$_] for 8..14;
+ unshift @user, $self->[0];
+ $user = join ':', @user;
+ for(@file){ s/.+/$user/ if /^\Q$name\E:/ }
+ _io("$file_shadow", \@file, 'w') and return 1
+ }
+
+ }
+ if($field{$what} > 6){
+ my @file = _io("$file_shadow", '', 'r');
+ $self->[9] = _get_1970_diff() if $field{$what} == 8;
+ if($field{$what} == 8 && $newval){
+ $oldval =~ /^!/ and my $lock = 1;
+ $self->[8] = _gen_pass($self->[$field{$what}], $lock) unless $flag;
+ }
+ my @user;
+ push @user, "$self->[$_]" for 7..15;
+ my $user = join ':', @user;
+ for(@file){ s/.+/$user/ if /^\Q$name\E:/ }
+ _io("$file_shadow", \@file, 'w');
+ if($field{$what} == 7){
+ @file = @user = ();
+ @file = _io("$file_passwd", '', 'r');
+ push @user, $self->[$_] for 1..6;
+ unshift @user, $self->[7];
+ $user = join ':', @user;
+ for(@file){ s/.+/$user/ if /^\Q$name\E:/ }
+ _io("$file_passwd", \@file, 'w') and return 1
+ }
+ }
+ }
+ elsif($self->[-1] eq '__G__'){
+ my $name = $self->[$gfield{NAME}];
+ my $oldval = $self->[$gfield{$what}];
+ $self->[$gfield{$what}] = $newval;
+ if($gfield{$what} == 0 or $gfield{$what} == 4){
+ croak "invalid name" if $newval !~ /^([A-Z]|[a-z]){1}\w{0,254}/;
+ my @file = _io($file_group, '', 'r');
+ my %names;
+ map{ m#^(.[^:]+):# and $names{$1} }@file;
+ croak "group name $newval already exists" if exists($names{$newval});
+ undef %names;
+ for(@file){
+ /^$oldval:/ or next;
+ my $newline = "$self->[0]:$self->[1]:$self->[2]:$self->[3]";
+ s/.+/$newline/;
+ }
+ _io($file_group, \@file, 'w');
+ @file = _io($file_gshadow, '', 'r');
+ for(@file){
+ /^$oldval:/ or next;
+ $self->[4] = $newval;
+ my $newline = "$self->[4]:$self->[5]:$self->[6]:$self->[7]";
+ s/.+/$newline/;
+ }
+ _io($file_gshadow, \@file, 'w') and return 1
+ }
+ if($gfield{$what} == 3 or $gfield{$what} == 7){
+ for(split /\s+/, $newval){
+ croak "$_ does not exist" unless(_exists($_))
+ }
+ my $users = join ',', split /\s+/, "$newval";
+ $self->[3] = $users;
+ my @file = _io($file_group, '', 'r');
+ for(@file){
+ /^\Q$name\E:/ or next;
+ my $newline = "$self->[0]:$self->[1]:$self->[2]:$self->[3]";
+ s/.+/$newline/;
+ }
+ _io($file_group, \@file, 'w');
+ @file = _io($file_gshadow, '', 'r');
+ $self->[7] = $users;
+ for(@file){
+ /^\Q$name\E:/ or next;
+ my $newline = "$self->[4]:$self->[5]:$self->[6]:$self->[3]";
+ s/.+/$newline/;
+ }
+ _io($file_gshadow, \@file, 'w') and return 1
+ }
+ if($gfield{$what} == 2){
+ croak "wrong group id" if $newval < 1 or $newval > 65535;
+ my %ids;
+ my @file = _io("$file_group", '', 'r');
+ map { /^.+?:.*?:(.+):/ and $ids{$1} = 1 } @file;
+ croak "group id $newval already exists" if $ids{$newval};
+ for(@file){
+ /^\Q$name\E:/ or next;
+ my $newline = "$self->[0]:$self->[1]:$self->[2]:$self->[3]";
+ s/.+/$newline/;
+ }
+ _io($file_group, \@file, 'w') and return 1
+ }
+ if($gfield{$what} == 6){
+ croak "user $newval does not exist" unless(_exists($newval));
+ $self->[6] = $newval;
+ my @file = _io($file_gshadow, '', 'r');
+ for(@file){
+ /^\Q$name\E:/ or next;
+ my $newline = "$self->[4]:$self->[5]:$self->[6]:$self->[7]";
+ s/.+/$newline/;
+ }
+ _io($file_gshadow, \@file, 'w') and return 1
+ }
+ if($gfield{$what} == 1 or $gfield{$what} == 5){
+ no strict 'refs';
+ my $salt = join '', ('a'..'z', 'A'..'Z', 0..9)[rand 26,rand 26,rand 26];
+ my $newpass;
+ if($newval)
+ { $newpass = crypt($newval, $salt) }
+ else
+ { $newpass = '!' }
+ my @file = _io($file_gshadow, '', 'r');
+ $self->[1] = 'x';
+ $self->[5] = $newpass;
+ for(@file){
+ /^\Q$name\E:/ or next;
+ my $newline = "$self->[4]:$self->[5]:$self->[6]:$self->[7]";
+ s/.+/$newline/;
+ }
+ _io($file_gshadow, \@file, 'w');
+ @file = _io($file_group, '', 'r');
+ for(@file){
+ /^\Q$name\E:/ or next;
+ my $newline = "$self->[0]:$self->[1]:$self->[2]:$self->[3]";
+ s/.+/$newline/;
+ }
+ _io($file_group, \@file, 'w') and return 1
+ }
+ }
+ return 0
+}
+
+sub _read_user {
+ my $username = shift;
+ my (@user, @tmp, @file);
+ @file = _io($file_passwd, '', 'r');
+ for(@file){
+ /^\Q$username\E:/ or next;
+ my $user = $_;
+ for(1..7){
+ $user =~ m#(.[^:]*){$_}#;
+ my $ss = $1;
+ $ss =~ s/(^:*|:*$)//;
+ $tmp[$_ - 1] = $ss;
+ } last
+ }
+ @user = @tmp;
+ @tmp = ();
+ @file = _io($file_shadow, '', 'r');
+ for(@file){
+ /^\Q$username\E:/ or next;
+ my $user = $_;
+ for(1..9){
+ $user =~ m#(.[^:]*){$_}#;
+ my $ss = $1;
+ $ss =~ s/(^:*|:*$)//;
+ $tmp[$_ - 1] = $ss;
+ } last
+ }
+ @user = (@user, @tmp);
+ return (@user);
+}
+
+sub _gen_pass {
+ my $password = shift;
+ my $flag = shift;
+ $password or croak "no password given";
+ my @rands = ( "A" .. "Z", "a" .. "z", 0 .. 9 );
+ my $salt = join("", @rands[ map { rand @rands } ( 1 .. 8 ) ]);
+ $password = ($flag)?'!'.crypt($password, q($1$)."$salt"):crypt($password, q($1$)."$salt");
+ return $password
+}
+
+sub _exists {
+ my $name = shift;
+ my $gflag = shift;
+ my $file = ($gflag) ? "$file_group" : "$file_passwd";
+ my @file = _io("$file", '', 'r');
+ my $flag;
+ /^\Q$name\E:/ and $flag = 1 for @file;
+ return $flag ? 1 : 0
+}
+
+sub add {
+ my $class = shift;
+ my (%fields, $c, @args);
+ push @args, $_ for @_;
+ croak "no username given" if scalar @args == 0;
+ croak "user $args[0] exists" if _exists($args[0]);
+ for(@args){
+ chomp($_);
+ /^\s*$/ and $c++ and next;
+ $c++;
+ if($c == 1){
+ croak "wrong username given" if /:/;
+ croak "wrong username" unless /^([A-Z]|[a-z]){1}\w{0,254}/;
+ $fields{username} = $_ || croak "no username given";
+ }
+ if($c == 2){
+ croak "wrong password length" unless /^(.*){0,254}$/;
+ $fields{password} = _gen_pass($_) if $_;
+ }
+ if($c == 3){
+ $_ eq '' and $_ = 1000;
+ croak "wrong uid" unless /^\d+$/;
+ croak "wrong uid" if $_ > 65535 or $_ < 1;
+ $fields{uid} = $_ || 1000;
+ }
+ if($c == 4){
+ $_ eq '' and $_ = 1000;
+ croak "wrong gid" unless /^\d+$/;
+ if(/^\d+$/){ croak "wrong gid" if $_ > 65535 or $_ < 1 }
+ $fields{gid} = $_ || $fields{uid};
+ }
+ if($c == 5){
+ croak "wrong comment given" if /:/;
+ $fields{comment} = $_;
+ }
+ if($c == 6){
+ croak "wrong home given" if /:/;
+ $fields{home} = $_;
+ }
+ if($c == 7){
+ croak " wrong shell given" if /:/;
+ $fields{shell} = $_;
+ }
+ }
+ $fields{password} or $fields{password} = '!';
+ my @file = _io("$file_passwd", '', 'r');
+ my @ids;
+ push @ids, (split /:/)[2] for @file;
+ for (@ids){
+ if ($fields{uid} == $_){
+ $fields{uid} = 1000;
+ last
+ }
+ }
+ if($fields{uid} == 1000){
+ for(sort @ids){
+ $_ < 1000 and next;
+ $fields{uid} == $_ and $fields{uid}++;
+ }
+ }
+ $fields{gid} = $fields{uid} if !$fields{gid};
+ my @newuser = ("$fields{username}:x:$fields{uid}:$fields{gid}:$fields{comment}:$fields{home}:$fields{shell}");
+ _io("$file_passwd", \@newuser, 'a');
+ my $time_1970 = _get_1970_diff();
+ @newuser = ("$fields{username}:$fields{password}:$time_1970:0:99999:7:::");
+ _io("$file_shadow", \@newuser, 'a');
+ return 1
+}
+
+sub grpadd {
+ my $class = shift;
+ my $group = shift or croak "empty group name";
+ my $gid = shift;
+ my $users = shift;
+ my (@tmp, %file, @newgroup);
+ my @file = _io("$file_group", '', 'r');
+ croak "wrong group name" unless $group =~ /^([A-Z]|[a-z]){1}\w{0,254}/;
+ map { @tmp = split /:/, $_ and $file{$tmp[0]} = $tmp[2] } @file;
+ exists($file{$group}) and croak "group $group already exists";
+ if(!$gid){
+ $gid = 100;
+ for(sort {$a <=> $b} values %file){
+ next if $_ < 100;
+ $gid == $_ and $gid++
+ }
+ }
+ my $userlist = join(',', split(/\s+/, $users));
+ @newgroup = ("$group:x:$gid:$userlist");
+ _io("$file_group", \@newgroup, 'a');
+ @newgroup = ("$group:!!::$userlist");
+ _io("$file_gshadow", \@newgroup, 'a');
+}
+
+sub del {
+ my $class = shift;
+ my $username = shift;
+ _exists($username) or croak "user $username does not exist";
+ my @old = _io("$file_passwd", '', 'r');
+ my @new;
+ /^\Q$username\E:/ or push @new, $_ for @old;
+ _io("$file_passwd", \@new, 'w');
+ @new = ();
+ @old = _io("$file_shadow", '', 'r');
+ /^\Q$username\E:/ or push @new, $_ for @old;
+ _io("$file_shadow", \@new, 'w');
+ return 1
+}
+
+sub grpdel {
+ my $class = shift;
+ my $group = shift or croak "empty group name/gid";
+ my (@tmp, %file);
+ my @file = _io("$file_group", '', 'r');
+ map { @tmp = split /:/, $_ and $file{$tmp[0]} = $tmp[2] } @file;
+ exists($file{$group}) or croak "group $group does not exists";
+ @tmp = ();
+ /^$group/ or push @tmp, $_ for @file;
+ _io("$file_group", \@tmp, 'w');
+ @file = _io("$file_gshadow", '', 'r');
+ @tmp = ();
+ /^$group/ or push @tmp, $_ for @file;
+ _io("$file_gshadow", \@tmp, 'w');
+
+}
+
+sub _read_grp {
+ my $group = shift or croak "empty group name/gid";
+ my (@tmp, @grp);
+ my @file = _io("$file_group", '', 'r');
+ for(@file){
+ /^$group:/ or next;
+ my $user = $_;
+ for(1..4){
+ $user =~ /(.[^:]*){$_}/;
+ my $ss = $1;
+ $ss =~ s/(^:*|:*$)//;
+ $tmp[$_ - 1] = $ss;
+ } last
+ }
+ @grp = @tmp;
+ @file = _io("$file_gshadow", '', 'r');
+ for(@file){
+ /^$group:/ or next;
+ my $user = $_;
+ for(1..4){
+ $user =~ /(.[^:]*){$_}/;
+ my $ss = $1;
+ $ss =~ s/(^:*|:*$)//;
+ $tmp[$_ - 1] = $ss;
+ } last
+ }
+ @grp = (@grp, @tmp);
+ return (@grp)
+}
+
+sub tobsd{
+ my $self = shift;
+ (my @file) = _io("$file_shadow", '', 'r');
+ my $name = $self->get('name');
+ my @user;
+ for(@file){
+ /^\Q$name\E:/ or next;
+ push @user, $name, ':';
+ push @user, $self->get('password'), ':';
+ push @user, $self->get('uid'), ':';
+ push @user, $self->get('gid'), ':';
+ push @user, ':';
+ push @user, $self->get('expire') || 0, ':';
+ push @user, $self->get('expire') || 0, ':';
+ push @user, $self->get('comment'), ':';
+ push @user, $self->get('home'), ':';
+ push @user, $self->get('shell');
+ my $user = join '', @user;
+ s/.*/$user/;
+ }
+ _io("$file_shadow", \@file, 'w');
+ return 1
+}
+
+sub _io{
+ my $file = shift;
+ my $newvals = shift;
+ my $flag = shift;
+ my @file;
+ croak $! unless -f $file;
+ local *FH;
+ die "posible flags: r/w/a" unless $flag =~ /^(r|w|a)$/;
+ if($flag eq 'r'){
+ open FH, $file or croak "can't open_r $file $!";
+ flock FH, LOCK_SH or croak "can't lock_sh $file";
+ @file = <FH>;
+ close FH;
+ map { s/\n// } @file;
+ return @file;
+ }
+ if($flag eq 'w'){
+ open FH, "> $file" or croak "can't open_w $file $!";
+ flock FH, LOCK_EX or croak "can't lock_ex $file";
+ print FH "$_\n" for @{$newvals};
+ close FH;
+ return 1
+ }
+ if($flag eq 'a'){
+ open FH, ">> $file" or croak "can't open_a $file $!";
+ flock FH, LOCK_EX or croak "can't lock_ex $file";
+ print FH "$_\n" for @{$newvals};
+ close FH;
+ return 1
+ }
+}
+
+sub users{
+ my $class = shift;
+ (my @file) = _io("$file_passwd", '', 'r');
+ my (%users, @users);
+ m#^(.[^:]+):# and push @users, $1 for @file;
+ map{ $users{$_} = 1 }@users;
+ return %users
+}
+
+sub grps{
+ my $class = shift;
+ (my @file) = _io("$file_group", '', 'r');
+ my (%users, @users);
+ m#^(.[^:]+):# and push @users, $1 for @file;
+ map{ $users{$_} = 1 }@users;
+ return %users
+}
+
+sub lock{
+ my $self = shift;
+ my $password = $self->get("password");
+ return 1 if $password =~ /^\!/;
+ $password =~ s/(.*)/!$1/;
+ $self->set("password", $password, 1);
+}
+
+sub unlock{
+ my $self = shift;
+ my $password = $self->get("password");
+ return if $password !~ /^\!/;
+ $password =~ s/^\!//;
+ $password ||= 'undef';
+ $self->set("password", $password, 1);
+}
+
+sub _get_1970_diff{ return int time / (3600 * 24) }
+
+sub _clean{
+ my $specchars = \shift;
+ my $special = qr#\$|\*|\@|\^|\+|\.|\?|\)|\(|\||\]|\[|\{|\}#;
+ $$specchars =~ s/($special)/\\$1/g;
+}
+
+1
+
+__END__
+
+=head1 NAME
+
+Linux::usermod - modify user and group accounts
+
+=head1 SYNOPSIS
+
+ use Linux::usermod;
+
+ $user = Linux::usermod->new(username);
+ $grp = Linux::usermod->new(groupname, 1);
+
+ $user->get(gid); # equal to $user->get(3);
+ $user->get(uid); # equal to $user->get(2);
+ $grp->get(gid); # equal to $user->get(2);
+ $grp->get(users);# equal to $user->get(3);
+
+ #lock and unlock user account
+
+ $user->lock();
+ $user->unlock();
+
+ #get password(passwd file)
+ $user->get(ppassword);
+
+ #get encoded password(shadow file)
+ $user->get(password);
+
+ #set encoded password
+ $user->set(password);
+ $grp->set(password);
+
+ #set shell / group administrator
+ $user->set(shell);
+ $grp->set(ga);
+
+ #set group users
+ @users = qw(user1 user2);
+ $grp->set(users, "@users");
+
+ Linux::usermod->add(username);
+
+ #or
+
+ Linux::usermod->add(username, password, uid, gid, comment, home, shell);
+
+ #where the password goes in shadow file and gid becomes
+ #equal to uid unless specified and uid is becoming the
+ #first unreserved number after 1000 unless specified
+
+ #or
+
+ @users = qw(user1 user2 user3);
+ Linux::usermod->grpadd(groupname, gid, "@users")
+
+ #where the password goes in gshadow file and gid becomes
+ #equal to the second argument or the first unreserved number
+ #after 100
+
+ #delete user/group
+ Linux::usermod->del(username);
+ Linux::usermod->grpdel(groupname);
+
+ #all fields are returned from the class methods fields/gfields
+ print $user->get($_) for (Linux::usermod->fields);
+ print $grp->get($_) for (Linux::usermod->gfields);
+
+ #set working passwd and shadow files
+
+ #$Linux::usermod::file_passwd = "./my_passwd";
+ #$Linux::usermod::file_shadow = "./my_shadow";
+ #$Linux::usermod::file_group = "./my_group";
+ #$Linux::usermod::file_gshadow= "./my_gshadow";
+
+=head1 DESCRIPTION
+
+This module adds, removes and modify user and group accounts according to
+the passwd and shadow files syntax (like struct passwd from pwd.h). It is not necessary
+those accounts to be system as long as $Linux::usermod::file_passwd, $Linux::usermod::file_shadow,
+$Linux::usermod::file_group, $Linux::usermod::file_gshadow are not in "/etc" directory.
+
+=head1 METHODS
+
+=over 8
+
+=item new
+
+ Linux::usermod->new(username)
+ Linux::usermod->new(grpname, 1)
+
+If group object second 'true' argument must be given
+
+=item add
+
+(username, ...)
+Class method - add new user account; arguments are optional, except username;
+they may be (username, password, uid, gid, comment, home, shell)
+
+=item del
+
+(username)
+Class method - removes user account
+
+=item tobsd
+
+converts user fields in shadow / master.passwd file to bsd style
+
+=item get
+
+if used with user object returns one of the following fields:
+
+ 'name' or 0 The user's name
+ 'ppassword' or 1 The "passwd" file password
+ 'uid' or 2 The user's id
+ 'gid' or 3 The user's group id
+ 'comment' or 4 The comment about the user (real username)
+ 'home' or 5 The user's home directory
+ 'shell' or 6 The user's shell
+ 'sname' or 7 The user's name in shadow file
+ 'password' or 8 The 13-character encoded password
+ 'lastchg' or 9 The number of days since January 1, 1970 of the last password changed date
+ 'min' or 10 The minimum number of days required between password changes
+ 'max' or 11 The maximum number of days the password is valid
+ 'warn' or 12 The number of days before expiring the password that the user is warned
+ 'inactive' or 13 The number of days of inactivity allowed for the user
+ 'expire' or 14 The number of days since January 1, 1970 that account is disabled
+ 'flag' or 15 Currently not used
+
+if used with group object returns one of the following fields:
+
+ 'name' or 0 The group name
+ 'ppassword' or 1 The group password
+ 'gid' or 2 The group id number
+ 'users' or 3 The group members (users)
+ 'sname' or 4 The group name in gshadow file (the same as 'name')
+ 'password' or 5 The encrypted group password
+ 'ga' or 6 The group administrators
+ 'gu' or 7 The group members (users) (the same as 'users')
+
+argument can be either string or number
+
+
+=item set
+
+(field)
+
+set a field which must be string of characters:
+
+ @user_fields = Linux::usermod->fields; #user fields
+ @group_fields = Linux::usermod->gfields; #group fields
+
+=item grpadd
+
+(groupname)
+
+=item grpdel
+
+(groupname)
+
+=item lock
+
+(username)
+Lock user account (puts '!' at the beginning of the encoded password)
+
+=item unlock
+
+(username)
+Unlock user account (removes '!' from the beginning of the encoded password)
+
+=item users
+
+Class method - return hash which keys are all users, taken from $file_passwd
+
+=item grps
+
+Class method - return hash which keys are all groups, taken from $file_group
+
+=back
+
+=head1 FILES
+
+/etc/passwd
+/etc/shadow
+/etc/group
+/etc/gshadow
+
+unless given your own passwd, shadow, group, gshadow files
+which must be created
+
+=head1 TO DO
+
+Groups and user accounts consistency checks
+
+=head1 SEE ALSO
+
+getpwent(3), getpwnam(3), usermod(8), passwd(1), gpasswd(1)
+
+=head1 BUGS
+
+None known. Report any to author.
+
+=head1 AUTHOR
+
+Vidul Petrov, vidul at abv.bg
+
+© 2004 Vidul Petrov. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+
+=cut
Added: branches/upstream/liblinux-usermod-perl/current/usrm
URL: http://svn.debian.org/wsvn/branches/upstream/liblinux-usermod-perl/current/usrm?rev=12417&op=file
==============================================================================
--- branches/upstream/liblinux-usermod-perl/current/usrm (added)
+++ branches/upstream/liblinux-usermod-perl/current/usrm Thu Jan 10 10:56:01 2008
@@ -1,0 +1,56 @@
+#!/usr/bin/perl
+use Linux::usermod;
+use Getopt::Std;
+use File::Basename;
+getopt('u:n:p:s:h:c:k:a:d:A:D:');
+
+$proname = basename($0);
+if(!opt_a or !$opt_d or !$opt_b){
+ die &usage unless $opt_u && $opt_p ||
+ $opt_L ||
+ $opt_U ||
+ $opt_c ||
+ $opt_h ||
+ $opt_s ||
+ $opt_n ||
+ $opt_a ||
+ $opt_d ||
+ $opt_b ||
+ $opt_A ||
+ $opt_D
+}
+Linux::usermod->add($opt_a) and exit if $opt_a;
+Linux::usermod->del($opt_d) and exit if $opt_d;
+Linux::usermod->grpadd($opt_A) and exit if $opt_A;
+Linux::usermod->grpdel($opt_D) and exit if $opt_D;
+$user = Linux::usermod->new($opt_u);
+die "No such user\n" unless defined $user->get(uid);
+$user->set(password, $opt_p) if $opt_p;
+$user->set(comment, $opt_c) if $opt_c;
+$user->set(home, $opt_h) if $opt_h;
+$user->set(shell, $opt_s) if $opt_s;
+$user->set(name, $opt_n) if $opt_n;
+$user->tobsd() if $opt_b;
+$user->lock if $opt_L;
+$user->unlock if $opt_U;
+sub usage{
+ print <<SQ;
+$proname:
+ -n name
+ -a add
+ -d delete
+ -b to bsd style
+ -h home
+ -s shell
+ -c comment
+ -p new_password
+ -U unlock
+ -L lock
+ -u username
+ -A groupname
+ -D groupname
+SQ
+ exit 0
+}
+
+
Propchange: branches/upstream/liblinux-usermod-perl/current/usrm
------------------------------------------------------------------------------
svn:executable =
More information about the Pkg-perl-cvs-commits
mailing list