Unix-ConfigFile-0.06/004075500073060000165000000000000710357700300154545ustar00ssnodgrausers00002710000002Unix-ConfigFile-0.06/auto_home.orig010044400073060000165000000003060670544636700203270ustar00ssnodgrausers00002710000002bigguy fileserv1:/home/& coolguy anotherserver:/export/home/& fsi -rw,intr fileserv1:/home/fsi yp -ro netinfo:/var/yp default -ro raid-01:/default raid-02:/default ssnodgra fileserv1:/home/& Unix-ConfigFile-0.06/README010044400073060000165000000031140710357630200163270ustar00ssnodgrausers00002710000002Welcome to Unix::ConfigFile 0.06. This is an *alpha* release. That means that interfaces may change in the future and there will probably be some bugs lurking around. You have been warned. The Unix::ConfigFile distribution is a suite of modules that provide simple interfaces to various Unix configuration files. The objective is to free the system administrator from dealing with the trivial formatting details of the files, and allow him or her to concentrate on the information therein. Currently supported files include: aliases Unix::AliasFile automount Unix::AutomountFile group Unix::GroupFile passwd Unix::PasswdFile You can install this module in the usual way: perl Makefile.PL make make test make install These modules will work with perl 5.004 or higher. However, the AliasFile module may exhibit a minor bug under versions less than 5.005; see the AliasFile documentation for details. The documentation is embedded in each module; use perldoc (e.g. perldoc Unix::PasswdFile) after installation to get started. A mailing list is available for discussions regarding the Unix::ConfigFile module. To subscribe, send an email with "subscribe" (without the quotes) in the body of your message (the subject will be ignored) to: configfile-request@trfn.clpgh.org This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. Copyright 1999 Steve Snodgrass. These modules are written by Steve "Pheran" Snodgrass, ssnodgra@fore.com. Additional contributors include: James Walden Unix-ConfigFile-0.06/MANIFEST010044400073060000165000000003550710357650200166060ustar00ssnodgrausers00002710000002Changes AliasFile.pm AutomountFile.pm ConfigFile.pm GroupFile.pm PasswdFile.pm MANIFEST README Makefile.PL test.pl aliases.orig aliases.test auto_home.orig auto_home.test group.orig group.test passwd.orig passwd.test examples/grouper.pl Unix-ConfigFile-0.06/group.orig010044400073060000165000000004270670544636700175070ustar00ssnodgrausers00002710000002root::0:root other::1: bin::2:root,bin,daemon sys::3:root,bin,sys,adm adm::4:root,adm,daemon uucp::5:root,uucp mail::6:root tty::7:root,tty,adm lp::8:root,lp,adm nuucp::9:root,nuucp staff::10: daemon:*:12:root,daemon sysadmin::14: nobody::60001: noaccess::60002: nogroup::65534: Unix-ConfigFile-0.06/aliases.test010044400073060000165000000041220672727370400200040ustar00ssnodgrausers00002710000002#ident "@(#)aliases 1.13 92/07/14 SMI" /* SVr4.0 1.1 */ ## # Aliases can have any mix of upper and lower case on the left-hand side, # but the right-hand side should be proper case (usually lower) # # >>>>>>>>>> The program "newaliases" will need to be run after # >> NOTE >> this file is updated for any changes to # >>>>>>>>>> show through to sendmail. # # @(#)aliases 1.8 86/07/16 SMI ## # Following alias is required by the mail protocol, RFC 822 # Set it to the address of a HUMAN who deals with this system's mail problems. Postmaster: root # Alias for mailer daemon; returned messages from our MAILER-DAEMON # should be routed to our local Postmaster. MAILER-DAEMON: postmaster # Aliases to handle mail to programs or files, eg news or vacation # decode: "|/usr/bin/uudecode" nobody: /dev/null # Alias for distribution list, members specified here: staff: anothertest,bonon,bozon,ecc,extent1,extent5,mckusick,moretests,mosher, rwh@ernie,sam,test1,test3,wnj # Alias for distribution list, members specified elsewhere: #keyboards: :include:/usr/jfarrell/keyboards.list # Alias for a person, so they can receive mail by several names: #epa:eric ####################### # Local aliases below # ####################### root: :include:/lists/superusers webmaster: lwall,webby,webdude,webguy # # Aliases for Majordomo mailing lists # majordomo: "|/usr/local/majordomo/wrapper majordomo" owner-majordomo: bigguy majordomo-owner: bigguy # Aliases for mylist-l list mylist-l: "|/usr/local/majordomo/wrapper resend -l mylist-l mylist-l-list" mylist-l-list: :include:/usr/local/majordomo/lists/mylist-l owner-mylist-l: bigguy,foobar mylist-l-request: "|/usr/local/majordomo/wrapper majordomo -l mylist-l" mylist-l-approval: bigguy # Aliases for yourlonglist-l list yourlonglist-l: "|/usr/local/majordomo/wrapper resend -l yourlonglist-l yourlonglist-l-list" yourlonglist-l-list: :include:/usr/local/majordomo/lists/yourlonglist-l owner-yourlonglist-l: bigguy,foobar yourlonglist-l-request: "|/usr/local/majordomo/wrapper majordomo -l yourlonglist-l" yourlonglist-l-approval: bigguy # Funny guys stooges: curly,larry,moe Unix-ConfigFile-0.06/test.pl010044400073060000165000000220600710357656600170000ustar00ssnodgrausers00002710000002# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' # $Id: test.pl,v 1.4 2000/05/02 16:07:48 ssnodgra Exp $ ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..58\n"; } END {print "not ok 1\n" unless $loaded;} use Unix::AliasFile; use Unix::AutomountFile; use Unix::GroupFile; use Unix::PasswdFile; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): $num = 2; # # Unix::PasswdFile tests # # Test 2 - initialize PasswdFile object print `cp passwd.orig passwd`; chmod 0644, "passwd"; $pw = new Unix::PasswdFile "./passwd"; $status = defined $pw ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 3 - locking test $pw2 = new Unix::PasswdFile "./passwd"; $status = !defined $pw2 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 4 - passwd accessor $status = $pw->passwd("lp") eq "x" ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 5 - uid accessor $status = $pw->uid("adm") == 4 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 6 - gid accessor $status = $pw->gid("sys") == 3 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 7 - gecos accessor $status = $pw->gecos("myself") eq "Me" ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 8 - home accessor $status = $pw->home("adm") eq "/usr/adm" ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 9 - shell accessor $status = $pw->shell("root") eq "/bin/csh" ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 10 - add user $pw->user("test", "*", 8192, 2048, "Testy Test", "/home/test", "/bin/ksh"); $status = $pw->uid("test") == 8192 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 11 - modify user $pw->uid('test', 2112); $status = $pw->uid("test") == 2112 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 12 - delete user $pw->delete("myself"); $status = !defined $pw->user("myself") ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 13 - access undefined data $status = !defined $pw->uid("myself") ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 14 - get maximum uid $status = $pw->maxuid == 60001 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 15 - get maximum uid with ignore $status = $pw->maxuid(60000) == 2112 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 16 - get list of users $status = $pw->users == 8 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 17 - commit the file $pw->commit(); $status = !`diff passwd passwd.test` ? "ok" : "not ok"; print "$status ", $num++, "\n"; unlink "passwd"; # # Unix::GroupFile tests # # Test 18 - initialize GroupFile object print `cp group.orig group`; chmod 0644, "group"; $grp = new Unix::GroupFile "./group"; $status = defined $grp ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 19 - locking test $grp2 = new Unix::GroupFile "./group"; $status = !defined $grp2 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 20 - gid accessor $status = $grp->gid("staff") == 10 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 21 - passwd accessor $status = $grp->passwd("daemon") eq "*" ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 22 - add group $grp->group("mygroup", "", 5150, "root", "johndoe", "bongo"); $status = $grp->gid("mygroup") == 5150 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 23 - add users to group $grp->add_user("mygroup", "dude1", "dude2"); $status = $grp->members("mygroup") == 5 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 24 - remove users from group $grp->remove_user("mygroup", "root"); $status = $grp->members("mygroup") == 4 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 25 - remove users from all groups $grp->remove_user("*", "bin"); $status = $grp->members("sys") == 3 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 26 - modify group $grp->group("staff", "*", 20, "dilbert", "wally", "alice"); $status = $grp->members("staff") == 3 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 27 - illegal attempt to reuse GID $status = !$grp->gid("mygroup", 20) ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 28 - delete group $grp->delete("tty"); $status = !$grp->group("tty") ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 29 - get maximum GID $status = $grp->maxgid == 65534 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 30 - get list of groups $status = $grp->groups == 16 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 31 - rename a user $status = $grp->rename_user("adm", "admin") == 3 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 32 - commit the file $grp->commit(); $status = !`diff group group.test` ? "ok" : "not ok"; print "$status ", $num++, "\n"; unlink "group"; # # Unix::AliasFile tests # # Test 33 - initialize AliasFile object print `cp aliases.orig aliases`; chmod 0644, "aliases"; $al = new Unix::AliasFile "./aliases"; $status = defined $al ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 34 - locking test $al2 = new Unix::AliasFile "./aliases"; $status = !defined $al2 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 35 - alias accessor $status = $al->alias("staff") == 18 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 36 - add alias $al->alias("stooges", qw(larry curly moe)); $status = $al->alias("stooges") == 3 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 37 - add users to alias $al->add_user("webmaster", "webguy", "perlgod", "webby"); $status = $al->alias("webmaster") == 4 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 38 - remove users from alias $al->remove_user("staff", qw(sklower olson bogon test2)); $status = $al->alias("staff") == 14 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 39 - remove users from all aliases $al->remove_user("*", "owner1"); $status = $al->alias("owner-mylist-l") == 2 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 40 - access undefined data $status = !defined $al->alias("noalias") ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 41 - modify alias $al->alias("root", ":include:/lists/superusers"); $status = $al->alias("root") == 1 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 42 - delete alias $al->delete("abuse"); $status = !defined $al->alias("abuse") ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 43 - get list of aliases $status = $al->aliases == 20 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 44 - add comment $ret = $al->comment("stooges", "# Funny guys"); $status = $ret ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 45 - remove comment $ret = $al->uncomment("# Sample aliases:"); $status = $ret ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 46 - rename user $status = $al->rename_user("perlgod", "lwall") == 1 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 47 - commit the file $al->commit(); $status = !`diff aliases aliases.test` ? "ok" : "not ok"; print "$status ", $num++, "\n"; unlink "aliases"; # # Unix::AutomountFile tests # # Test 48 - initialize AutomountFile object print `cp auto_home.orig auto_home`; chmod 0644, "auto_home"; $am = new Unix::AutomountFile "./auto_home"; $status = defined $am ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 49 - locking test $am2 = new Unix::AutomountFile "./auto_home"; $status = !defined $am2 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 50 - options accessor $status = $am->options("fsi") eq "-rw,intr" ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 51 - add automount point $am->automount("bozo", "fileserv1:/users/&", "fileserv2:/users/&"); $status = $am->automount("bozo") == 2 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 52 - add servers to existing automount point $am->add_server("bozo", "fileserv3:/users/&"); $status = $am->automount("bozo") == 3 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 53 - change automount options $am->options("bozo", "-rw,nosuid"); $status = $am->options("bozo") eq "-rw,nosuid" ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 54 - modify automount point $am->automount("ssnodgra", $am->automount("bozo")); $status = $am->automount("ssnodgra") == 3 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 55 - delete automount point $am->delete("bigguy"); $status = !defined $am->automount("bigguy") ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 56 - get list of mount points $status = $am->automounts == 6 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 57 - rename mount point $am->rename("coolguy", "linus"); $status = $am->automount("linus") == 1 ? "ok" : "not ok"; print "$status ", $num++, "\n"; # Test 58 - commit the file $am->commit(); $status = !`diff auto_home auto_home.test` ? "ok" : "not ok"; print "$status ", $num++, "\n"; unlink "auto_home"; Unix-ConfigFile-0.06/ConfigFile.pm010044400073060000165000000304130710357444500200220ustar00ssnodgrausers00002710000002package Unix::ConfigFile; # $Id: ConfigFile.pm,v 1.6 2000/05/02 15:49:19 ssnodgra Exp $ use 5.004; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $LOCKEXT); use Carp; use IO::File; use Fcntl qw(:flock); use Text::Tabs; require Exporter; @ISA = qw(Exporter); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw( ); $VERSION = '0.06'; # Package variables my $SALTCHARS = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789/."; # Preloaded methods go here. # Create a new ConfigFile (or, more likely, a ConfigFile subclass) object. # Opens the specified file and calls the read method (which will be located # in the subclass package) to initialize the object data structures sub new { my ($pkg, $filename, %opt) = @_; # Initialize the object reference my $this = { filename => $filename, handle => undef, locked => 0, lockfh => undef, lockfile => "$filename.lock", locking => "dotlock", mode => "r+", seq => [ ] }; bless $this, $pkg; # Set options $this->lockfile($opt{lockfile}) if defined $opt{lockfile}; $this->locking($opt{locking}) if defined $opt{locking}; $this->mode($opt{mode}) if defined $opt{mode}; # Get a filehandle my $fh = new IO::File $this->filename, $this->mode; return undef unless defined($fh); $this->fh($fh); # Do file locking - this must happen before read is called or we could # end up with stale data in memory if ($this->mode eq "r") { $this->lock("shared") or return undef; } else { $this->lock() or return undef; } # Initialize object structure from the file if (exists $opt{readopts}) { $this->read($this->fh, $opt{readopts}) or return undef; } else { $this->read($this->fh) or return undef; } return $this; } # Commit in-memory changes to disk sub commit { my ($this, %opt) = @_; return 0 if $this->mode eq "r"; my $tempname = $this->filename . ".tmp." . $$; my $fh = new IO::File ">$tempname" or return 0; my ($mode, $uid, $gid) = (stat $this->fh)[2,4,5]; chown $uid, $gid, $tempname; chmod $mode, $tempname; if (exists $opt{writeopts}) { $this->write($fh, $opt{writeopts}) or return 0; } else { $this->write($fh) or return 0; } undef $fh; if (defined $opt{backup}) { rename $this->filename, $this->filename . $opt{backup}; } return rename $tempname, $this->filename; } # This method is absolutely necessary to prevent leftover lock files sub DESTROY { my $this = shift; $this->unlock() or croak "Can't unlock file: $!"; $this->fh->close(); } # Filename accessor sub filename { my $this = shift; @_ ? $this->{filename} = shift : $this->{filename}; } # Filehandle accessor sub fh { my $this = shift; @_ ? $this->{handle} = shift : $this->{handle}; } # Locking method accessor sub locking { my $this = shift; return $this->{locking} unless @_; my $lockmethod = shift; return undef unless grep { $lockmethod eq $_ } qw(flock dotlock none); $this->{locking} = $lockmethod; } # Lock filehandle accessor sub lockfh { my $this = shift; @_ ? $this->{lockfh} = shift : $this->{lockfh}; } # Lock file name accessor sub lockfile { my $this = shift; @_ ? $this->{lockfile} = shift : $this->{lockfile}; } # Mode accessor sub mode { my $this = shift; return $this->{mode} unless @_; my $mode = shift; return undef unless grep { $mode eq $_ } qw(r r+ w); $this->{mode} = $mode; } # Obtain a lock on the file. You can pass "shared" to request a shared lock; # the default is exclusive. This function is somewhat inconsistent at the # moment since it will block with the flock method but return an error if the # dotlock method fails. sub lock { my $this = shift; return 1 if ($this->locking eq "none"); return 0 if $this->{locked}; if ($this->locking eq "flock") { @_ ? flock $this->fh, LOCK_SH : flock $this->fh, LOCK_EX; } elsif ($this->locking eq "dotlock") { # We only support exclusive locks with dotlock my $fh = new IO::File $this->lockfile, O_CREAT|O_EXCL|O_RDWR; return 0 unless defined($fh); $this->lockfh($fh); } $this->{locked} = 1; } # Unlock the file sub unlock { my $this = shift; # NOTE: Originally I wasn't unlinking the lock file unless the lock # filehandle was defined. This led to the rather unexpected discovery # the Perl would sometimes destroy the filehandle before destroying # the object during program shutdown. Thus, we now check if locked # is set, which happens only if a lock is successfully acquired. # This also prevents us from unlinking someone else's lock file. return 1 if ($this->locking eq "none"); return 0 unless $this->{locked}; $this->{locked} = 0; if ($this->locking eq "flock") { flock $this->fh, LOCK_UN; return 1; } elsif ($this->locking eq "dotlock") { $this->lockfh->close() if defined($this->lockfh); my $result = unlink $this->lockfile; return ($result == 1); } } # Encrypts a plaintext password with a random salt # This is provided for use with the subclasses sub encpass { my ($this, $pass) = @_; my $salt = substr($SALTCHARS, int(rand(length($SALTCHARS))), 1) . substr($SALTCHARS, int(rand(length($SALTCHARS))), 1); crypt($pass, $salt); } # Return the file sequence sub sequence { my $this = shift; return @{$this->{seq}}; } # Append information to the file sequence sub seq_append { my $this = shift; push @{$this->{seq}}, @_; } # Insert information into the file sequence before the given data sub seq_insert { my $this = shift; my $data = shift; for (my $i = 0; $i < @{$this->{seq}}; $i++) { if ($this->{seq}[$i] eq $data) { splice @{$this->{seq}}, $i, 0, @_; return 1; } } return 0; } # Remove the specified data from the file sequence sub seq_remove { my ($this, $data) = @_; for (my $i = 0; $i < @{$this->{seq}}; $i++) { if ($this->{seq}[$i] eq $data) { splice @{$this->{seq}}, $i, 1; return 1; } } return 0; } # Joinwrap is a utility function that happens to be useful in several modules # This thing was a bitch to get working 100% right, so use caution. :-) sub joinwrap { my ($this, $linelen, $head, $indent, $delim, $tail, @list) = @_; my $result = ""; my $line = 0; $linelen -= length(expand($tail)); while (@list) { my $curline = $result ? $indent : $head; $curline =~ s/%n/$line/; my $appended = 0; while (@list && length(expand($curline . $delim . $list[0])) <= $linelen) { $curline .= $delim if $appended; $curline .= shift @list; $appended++; } # Special case - element is longer than linelen $curline .= shift @list unless $appended; # Append newline if this isn't the first line $result .= "\n" if $result; $result .= $curline; # Append tail unless this is the last line $result .= $tail if @list; $line++; } $result ? $result : $head; } # Autoload methods go after =cut, and are processed by the autosplit program. 1; __END__ =head1 NAME Unix::ConfigFile - Perl interface to various Unix configuration files =head1 SYNOPSIS use Unix::ConfigFile; =head1 DESCRIPTION The Unix::ConfigFile module provides a base class from which the other Unix::*File modules are derived. It provides some basic facilities like file opening, locking, and closing. You do not need to use this module directly unless you are developing a derived module for an unsupported configuration file. However, some of the methods documented here are intended for public use by users of Unix::ConfigFile submodules, so you may find this documentation useful even if you are not developing your own module. The ConfigFile object also provides a sequencing API for modules that wish to preserve the order of the configuration file they read and write. The sequencer maintains a list of arbitrary data that a submodule may append, insert, and delete from. Use of the sequencer is completely optional. A module that subclasses from Unix::ConfigFile must, at a minimum, provide two methods, called "read" and "write". Both methods will receive a filehandle as a parameter (besides the regular object parameter). The read method is called after the file is opened. It is expected to read in the configuration file and initialize the subclass-specific data structures associated with the object. The write method is called when an object is committed and is expected to write out the new configuration to the supplied filehandle. =head1 USER METHODS =head2 commit( [%OPTIONS] ) This writes any changes you have made to the object back to disk. If you do not call commit, none of your changes will be reflected in the file you are modifying. Commit may not be called on files opened in read-only mode. There are some optional parameters that may be provided; these are passed in the form of key => value pairs. The "backup" option allows you to specify a file extension that will be used to save a backup of the original file. The "writeopts" option passes module-specific options through to the write method. It will accept any scalar for its value; typically this will be a list or hash reference. Commit returns 1 on success and 0 on failure. =head2 encpass( PASSWORD ) This method encrypts the supplied plaintext password using a random salt and returns the encrypted password. Note that this method does not actually make any use of the object that it is invoked on, and could be called as a class method. =head2 new( FILENAME [,%OPTIONS] ) The new method constructs a new ConfigFile (or subclass) object using the specified FILENAME. There are several optional parameters that may be specified. Options must be passed as keyed pairs in the form of option => value. Valid options are "locking", "lockfile", "mode", and "readopts". The locking option determines what style of file locking is used; available styles are "dotlock", "flock", and "none". The default locking style is "dotlock". The "none" locking style causes no locking to be done, and all lock and unlock requests will return success. The lockfile option can be used to specify the lock filename used with dotlocking. The default is "FILENAME.lock", where FILENAME is the name of the file being opened. The mode option allows the file open mode to be specified. The default mode is "r+" (read/write), but "r" and "w" are accepted as well. Finally, the readopts option allows module-specific options to be passed through to the read method. It will accept any scalar for its value; typically this will be a list or hash reference. =head1 DEVELOPER METHODS =head2 joinwrap( LENGTH, HEAD, INDENT, DELIM, TAIL, @LIST ) This is a utility function that may be called as an object or class method. As the name suggests, this method is basically a version of the join function that incorporates line wrapping. The specified list will be joined together, with each list element separated by the specified delimiter. The first line of output will be prefixed with the HEAD parameter. If a line exceeds the length parameter, output is wrapped to the next line and the INDENT parameter is used to prefix the line. In addition, the TAIL parameter will be added to the end of every line generated except the final one. There is one case where the resulting string can exceed the specified line length - if a single list element, plus HEAD or INDENT, exceeds that length. One final feature is that if the HEAD or INDENT parameters contain the text '%n', it will be replaced with the current line number, beginning at 0. =head2 sequence( ) Returns the current sequence list associated with the object. This is a list of arbitrary data maintained by a ConfigFile submodule. The ConfigFile module does not care what is contained in the list. =head2 seq_append( @DATA ) Appends that specified data to the end of the sequence list. =head2 seq_insert( KEY, @DATA ) Inserts the data into the sequence list before the data that matches the specified key. =head2 seq_remove( KEY ) Removes the data from the sequence list that matches the specified key. =head1 AUTHOR Steve Snodgrass, ssnodgra@fore.com =head1 SEE ALSO Unix::AliasFile, Unix::AutomountFile, Unix::GroupFile, Unix::PasswdFile =cut ame; if (exists $opt{writeopts}) { $this->write($fh, $opt{writeopts}) or return 0; } else { $this->write($fh) or return 0; } undef $fh; if (defined $opt{backup}) { rename $this->filename, $this->filename . $opt{backup}Unix-ConfigFile-0.06/PasswdFile.pm010044400073060000165000000174070710357553600200700ustar00ssnodgrausers00002710000002package Unix::PasswdFile; # $Id: PasswdFile.pm,v 1.5 2000/05/02 15:58:36 ssnodgra Exp $ use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use Unix::ConfigFile; require Exporter; @ISA = qw(Unix::ConfigFile Exporter); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw( ); $VERSION = '0.06'; # Implementation notes # # This module only adds a single field to the basic ConfigFile object. # The field is called 'pwent' (password entry) and is a hash of arrays # (or, more properly, a reference to a hash of references to arrays!). # The key is the username and the array contents are the next six fields # found in the password file. # Preloaded methods go here. # Read the file and build the data structures sub read { my ($this, $fh) = @_; while (<$fh>) { chop; $this->user(split /:/); } return 1; } # Add or change a user sub user { my $this = shift; my $username = shift; unless (@_) { return undef unless defined $this->{pwent}{$username}; return @{$this->{pwent}{$username}}; } return undef if @_ > 6; # Need to pad the list to 6 elements or we might lose colons during commit push @_, "" while @_ < 6; # Note: I first tried setting this to \@_. Bad idea! $this->{pwent}{$username} = [ @_ ]; } # Rename a user sub rename { my ($this, $olduser, $newuser) = @_; return 0 unless defined $this->user($olduser); $this->user($newuser, $this->user($olduser)); $this->delete($olduser); return 1; } # Delete a user sub delete { my ($this, $username) = @_; delete $this->{pwent}{$username}; } # Return the list of usernames # Accepts a sorting order parameter: uid or name (default uid) sub users { my $this = shift; my $order = @_ ? shift : "uid"; # Is there a way to make this work right in scalar context without # this check? I couldn't find one. return keys %{$this->{pwent}} unless wantarray; if ($order eq "name") { sort keys %{$this->{pwent}}; } else { sort { $this->uid($a) <=> $this->uid($b) } keys %{$this->{pwent}}; } } # Returns the maximum UID in use in the file sub maxuid { my ($this, $ignore) = @_; my @uids = sort { $a <=> $b } map { $this->{pwent}{$_}[1] } keys %{$this->{pwent}}; return undef unless @uids; my $retval = pop @uids; if (defined $ignore) { while ($retval >= $ignore && @uids) { $retval = pop @uids; } } return $retval; } # Output the file to disk sub write { my ($this, $fh) = @_; # Make sure to output root first if it exists if (defined $this->user("root")) { print $fh join(":", "root", $this->user("root")), "\n" or return 0; } foreach my $user ($this->users) { next if ($user eq "root"); print $fh join(":", $user, $this->user($user)), "\n" or return 0; } return 1; } # Accessors (these all accept a username and an optional value) # These must check for undefined data, or the act of accessing an array # element will create the data!! (This horrible bug nearly escaped into # the first alpha release. :-) sub passwd { my $this = shift; my $username = shift; return undef unless defined $this->{pwent}{$username}; @_ ? $this->{pwent}{$username}[0] = shift : $this->{pwent}{$username}[0]; } sub uid { my $this = shift; my $username = shift; return undef unless defined $this->{pwent}{$username}; @_ ? $this->{pwent}{$username}[1] = shift : $this->{pwent}{$username}[1]; } sub gid { my $this = shift; my $username = shift; return undef unless defined $this->{pwent}{$username}; @_ ? $this->{pwent}{$username}[2] = shift : $this->{pwent}{$username}[2]; } sub gecos { my $this = shift; my $username = shift; return undef unless defined $this->{pwent}{$username}; @_ ? $this->{pwent}{$username}[3] = shift : $this->{pwent}{$username}[3]; } sub home { my $this = shift; my $username = shift; return undef unless defined $this->{pwent}{$username}; @_ ? $this->{pwent}{$username}[4] = shift : $this->{pwent}{$username}[4]; } sub shell { my $this = shift; my $username = shift; return undef unless defined $this->{pwent}{$username}; @_ ? $this->{pwent}{$username}[5] = shift : $this->{pwent}{$username}[5]; } # Autoload methods go after =cut, and are processed by the autosplit program. 1; __END__ # Below is the stub of documentation for your module. You better edit it! =head1 NAME Unix::PasswdFile - Perl interface to /etc/passwd format files =head1 SYNOPSIS use Unix::PasswdFile; $pw = new Unix::PasswdFile "/etc/passwd"; $pw->user("joeblow", $pw->encpass("secret"), $pw->maxuid + 1, 10, "Joe Blow", "/export/home/joeblow", "/bin/ksh"); $pw->delete("deadguy"); $pw->passwd("johndoe", $pw->encpass("newpass")); foreach $user ($pw->users) { print "Username: $user, Full Name: ", $pw->gecos($user), "\n"; } $pw->commit(); undef $pw; =head1 DESCRIPTION The Unix::PasswdFile module provides an abstract interface to /etc/passwd format files. It automatically handles file locking, getting colons in the right places, and all the other niggling details. =head1 METHODS =head2 commit( [BACKUPEXT] ) See the Unix::ConfigFile documentation for a description of this method. =head2 delete( USERNAME ) This method will delete the named user. It has no effect if the supplied user does not exist. =head2 encpass( PASSWORD ) See the Unix::ConfigFile documentation for a description of this method. =head2 gecos( USERNAME [,GECOS] ) Read or modify a user's GECOS string (typically their full name). Returns the GECOS string in either case. =head2 gid( USERNAME [,GID] ) Read or modify a user's GID. Returns the GID in either case. =head2 home( USERNAME [,HOMEDIR] ) Read or modify a user's home directory. Returns the home directory in either case. =head2 maxuid( [IGNORE] ) This method returns the maximum UID in use by all users. If you pass in the optional IGNORE parameter, it will ignore all UIDs greater or equal to IGNORE when doing this calculation. This is useful for excluding accounts like nobody. =head2 new( FILENAME [,OPTIONS] ) See the Unix::ConfigFile documentation for a description of this method. =head2 passwd( USERNAME [,PASSWD] ) Read or modify a user's password. Returns the encrypted password in either case. If you have a plaintext password, use the encpass method to encrypt it before passing it to this method. =head2 rename( OLDNAME, NEWNAME ) This method changes the username for a user. If NEWNAME corresponds to an existing user, that user will be overwritten. It returns 0 on failure and 1 on success. =head2 shell( USERNAME [,SHELL] ) Read or modify a user's shell. Returns the shell in either case. =head2 uid( USERNAME [,UID] ) Read or modify a user's UID. Returns the UID in either case. =head2 user( USERNAME [,PASSWD, UID, GID, GECOS, HOMEDIR, SHELL] ) This method can add, modify, or return information about a user. Supplied with a single username parameter, it will return a six element list consisting of (PASSWORD, UID, GID, GECOS, HOMEDIR, SHELL), or undef if no such user exists. If you supply all seven parameters, the named user will be created or modified if it already exists. The six element list is also returned to you in this case. =head2 users( [SORTBY] ) This method returns a list of all existing usernames. By default the list will be sorted in order of the UIDs of the users. You may also supply "name" as a parameter to the method to get the list sorted by username. In scalar context, this method returns the total number of users. =head1 AUTHOR Steve Snodgrass, ssnodgra@fore.com =head1 SEE ALSO Unix::AliasFile, Unix::AutomountFile, Unix::ConfigFile, Unix::GroupFile =cut espace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw( ); $VERSION = '0.06'; # Implementation notes # # This mUnix-ConfigFile-0.06/Changes010044400073060000165000000030410710357673400167520ustar00ssnodgrausers00002710000002Revision history for Perl extension Unix::ConfigFile. 0.06 Tue May 2 12:08:17 2000 - Fixed documentation bugs - Optimized performance of maxuid() and added ignore parameter - Unix::PasswdFile now always writes out root as the first account - Fixed group() method to return parameters in the correct order - Added locking style "none" for no locking - Added example script examples/grouper.pl 0.05 Tue Jun 8 17:23:53 1999 - Renamed add/remove in AliasFile/GroupFile to add_user/remove_user - New and commit can now pass options through to read and write - All modules now have rename (or rename_user) methods - AliasFile and GroupFile now use "*" to mean all aliases/groups 0.04 Tue May 4 12:29:23 1999 - Corrected nasty bug in AliasFile that hosed multiline aliases - Really fixed the "embedded commas" bug in AliasFile this time 0.03 Mon May 3 21:29:59 1999 - The new() method has been redone and the open() method eliminated - The commit() method can now create backup files - AliasFile now works under 5.004, but with a minor bug (see docs) - Fixed bug in AliasFile that dropped empty aliases at read time - Added rename() method to PasswdFile to rename users - Added delempty() method to AliasFile to remove empty aliases - Minor code and documentation cleanups 0.02 Thu Apr 15 16:18:00 1999 - Added support for aliases and automounter files - ConfigFile now provides sequencing API, joinwrap, and commit - Various internal restructuring and improvements 0.01 Thu Feb 18 22:47:05 1999 - original version; created by h2xs 1.18 Unix-ConfigFile-0.06/Makefile.PL010044400073060000165000000003650670544636600174430ustar00ssnodgrausers00002710000002use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Unix::ConfigFile', 'VERSION_FROM' => 'ConfigFile.pm', # finds $VERSION ); Unix-ConfigFile-0.06/passwd.orig010044400073060000165000000005070670544636700176530ustar00ssnodgrausers00002710000002root:x:0:10:Charlie root:/:/bin/csh daemon:x:1:31:Mr Background:/: bin:x:2:100:System and local source:/bin:/bin/csh sys:x:3:3:Mr Kernel:/:/bin/csh adm:x:4:14:Adm account:/usr/adm:/bin/csh lp:x:71:100:Line Printer Account:/usr/lib/lp: myself:x:17:200:Me:/net/myself:/bin/csh nobody:x:60001:60001:Unprivileged user:/:/bin/false Unix-ConfigFile-0.06/auto_home.test010044400073060000165000000004240672727724500203500ustar00ssnodgrausers00002710000002bozo -rw,nosuid fileserv1:/users/& fileserv2:/users/& fileserv3:/users/& default -ro raid-01:/default raid-02:/default fsi -rw,intr fileserv1:/home/fsi linus anotherserver:/export/home/& ssnodgra fileserv1:/users/& fileserv2:/users/& fileserv3:/users/& yp -ro netinfo:/var/yp Unix-ConfigFile-0.06/AutomountFile.pm010044400073060000165000000132610710357455100206100ustar00ssnodgrausers00002710000002package Unix::AutomountFile; # $Id: AutomountFile.pm,v 1.4 2000/05/02 15:50:36 ssnodgra Exp $ use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use Unix::ConfigFile; require Exporter; @ISA = qw(Unix::ConfigFile Exporter); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw( ); $VERSION = '0.06'; # Implementation Notes # # This module adds 2 new fields to the basic ConfigFile object. The fields # are 'mount' and 'options'. Both of these fields are hashes. The mount # field is a hash of lists, where each list contains the possible server # mount points for the key, and the options field contains any options # associated with the key. The options field may not be defined if no # options were present. # Preloaded methods go here. # Read in the data structures from the supplied file sub read { my ($this, $fh) = @_; while (<$fh>) { chop; # Currently we nuke comments and blank lines. This may change. next if /^#/; next if /^$/; my @fields = split; my $key = shift @fields; my $options = undef; if ($fields[0] =~ /^-/) { $options = shift @fields; } $this->automount($key, @fields); $this->options($key, $options); } return 1; } # Add, modify, or get an automount point sub automount { my $this = shift; my $key = shift; # If no more parameters, we return automount info unless (@_) { return undef unless defined $this->{mount}{$key}; return @{$this->{mount}{$key}} unless wantarray; return sort @{$this->{mount}{$key}}; } $this->{mount}{$key} = [ @_ ]; $this->{options}{$key} = undef; return @{$this->{mount}{$key}} unless wantarray; return sort @{$this->{mount}{$key}}; } # Delete an automount entry sub delete { my ($this, $key) = @_; return 0 unless defined $this->{mount}{$key}; delete $this->{mount}{$key}; delete $this->{options}{$key}; return 1; } # Renames an automount entry sub rename { my ($this, $oldname, $newname) = @_; return 0 unless exists $this->{mount}{$oldname}; $this->{mount}{$newname} = $this->{mount}{$oldname}; $this->{options}{$newname} = $this->{options}{$oldname}; $this->delete($oldname); return 1; } # Add servers to an existing automount entry sub add_server { my $this = shift; my $key = shift; return 0 unless defined $this->{mount}{$key}; push @{$this->{mount}{$key}}, @_; return 1; } # Return the list of automount entries sub automounts { my $this = shift; return keys %{$this->{mount}} unless wantarray; return sort keys %{$this->{mount}}; } # Output file to disk sub write { my ($this, $fh) = @_; foreach my $key ($this->automounts) { print $fh "$key\t" or return 0; if (defined $this->options($key)) { print $fh $this->options($key), "\t" or return 0; } print $fh join(" ", $this->automount($key)), "\n" or return 0; } return 1; } # Set or return mount options sub options { my $this = shift; my $key = shift; return undef unless defined $this->{mount}{$key}; @_ ? $this->{options}{$key} = shift : $this->{options}{$key}; } # Autoload methods go after =cut, and are processed by the autosplit program. 1; __END__ # Below is the stub of documentation for your module. You better edit it! =head1 NAME Unix::AutomountFile - Perl interface to automounter files =head1 SYNOPSIS use Unix::AutomountFile; $am = new Unix::AutomountFile "/etc/auto_home"; $am->automount("newuser", "fileserver:/export/home/&"); $am->options("newuser", "-rw,nosuid"); $am->delete("olduser"); $am->commit(); undef $am; =head1 DESCRIPTION The Unix::AutomountFile module provides an abstract interface to automounter files. It automatically handles file locking, getting colons and commas in the right places, and all the other niggling details. WARNING: This module is probably Solaris specific at this point. I have only looked at Solaris format automount files thus far. Also, you cannot edit /etc/auto_master with this module, since it is in a different format than the other automount files. =head1 METHODS =head2 add_server( MOUNT, @SERVERS ) This method will add additional servers to an existing automount point. It returns 1 on success and 0 on failure. =head2 automount( MOUNT [,@SERVERS] ) This method can add, modify, or return information about a mount point. Supplied with a single mount parameter, it will return a list of the server entries for that mount point, or undef if no such mount exists. If you supply more than one parameter, the mount point will be created or modified if it already exists. The list is also returned to you in this case. =head2 automounts( ) This method returns a list of all existing mount points, sorted alphabetically. In scalar context, this method returns the total number of mount points. =head2 commit( [BACKUPEXT] ) See the Unix::ConfigFile documentation for a description of this method. =head2 delete( MOUNT ) This method will delete the named mount point. It has no effect if the supplied mount point does not exist. =head2 new( FILENAME [,OPTIONS] ) See the Unix::ConfigFile documentation for a description of this method. =head2 options( MOUNT [,OPTIONS] ) Read or modify the mount options associated with a mount point. Returns the options in either case. =head2 rename( OLDNAME, NEWNAME ) Renames a mount point. If NEWNAME corresponds to an existing mount point, that mount point is overwritten. Returns 0 on failure and 1 on success. =head1 AUTHOR Steve Snodgrass, ssnodgra@fore.com =head1 SEE ALSO Unix::AliasFile, Unix::ConfigFile, Unix::GroupFile, Unix::PasswdFile =cut this->{mount}{$oldname}; $this->{options}{$newname} = $this->{options}{$oldname}; $this->delete($oldname); return 1; } # Add servers to an existing automount entry sub add_server { my $this = shift; my $key = shift; return 0 unless defined $this->{mount}{$key}; push @{$this->{mount}{$key}}, @_; retuUnix-ConfigFile-0.06/group.test010044400073060000165000000004750672727266700175350ustar00ssnodgrausers00002710000002root::0:root other::1: bin::2:daemon,root sys::3:admin,root,sys adm::4:admin,daemon,root uucp::5:root,uucp mail::6:root lp::8:admin,lp,root nuucp::9:nuucp,root daemon:*:12:daemon,root sysadmin::14: staff:*:20:alice,dilbert,wally mygroup::5150:bongo,dude1,dude2,johndoe nobody::60001: noaccess::60002: nogroup::65534: Unix-ConfigFile-0.06/AliasFile.pm010044400073060000165000000217010710357452300176430ustar00ssnodgrausers00002710000002package Unix::AliasFile; # $Id: AliasFile.pm,v 1.5 2000/05/02 15:50:11 ssnodgra Exp $ use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use Unix::ConfigFile; use Text::ParseWords; require Exporter; @ISA = qw(Unix::ConfigFile Exporter); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw( ); $VERSION = '0.06'; # Implementation Notes # # This module adds one field to the basic ConfigFile object. The field # is called 'alias' and is a hash of hashes. The key is the alias name and # the subhash contains members of the alias as keys. The values of those # keys are normally just '1', but may be object references in the case of # :include: aliases. The module also makes use of the file sequencing # facility provided by ConfigFile to preserve comments and keep the file in # its original order. # Preloaded methods go here. # Read in the data structures from the supplied file sub read { my ($this, $fh) = @_; my $alias = ""; # Current alias being processed while (<$fh>) { if (/^#/ || /^$/) { # Comments/Blank Lines $this->seq_append($_); } elsif (/^[^\s]/) { # Alias start s/,?\s*$//; ($alias, my $rhs) = split /:\s*/, $_, 2; # I use the parse_line routine from Text::ParseWords here because # a simple split would hose program aliases with embedded commas. # Note that this routine does not exist prior to 5.005, so older # perl versions will have the comma bug. my @members; if ($] >= 5.005) { @members = parse_line(',\s*', 1, $rhs); } else { @members = split /,\s*/, $rhs; } # This weird little hack fixes a bug that caused empty aliases # to be deleted when the file was read, since the alias method # won't actually create an empty alias. $this->alias($alias, "empty"); $this->remove_user($alias, "empty"); $this->alias($alias, @members); } elsif (/^\s+$/) { # Junk whitespace $this->seq_append("\n"); } elsif (/^\s+/ && $alias) { # Alias continuation s/,?\s*$//; s/^\s+//; if ($] >= 5.005) { $this->add_user($alias, parse_line(',\s*', 1, $_)); } else { $this->add_user($alias, split /,\s*/); } } else { # What's this? die "Bogus line: $_"; } } return 1; } # Add, modify or get an alias sub alias { my $this = shift; my $name = shift; # If no more parameters, we return alias members unless (@_) { return undef unless defined $this->{alias}{$name}; return keys %{$this->{alias}{$name}} unless wantarray; return sort keys %{$this->{alias}{$name}}; } # Create or modify an alias $this->seq_append("_ALIAS_ $name") unless defined $this->{alias}{$name}; $this->{alias}{$name} = {}; $this->add_user($name, @_); return keys %{$this->{alias}{$name}} unless wantarray; return sort keys %{$this->{alias}{$name}}; } # Delete an alias sub delete { my ($this, $name) = @_; return 0 unless defined $this->{alias}{$name}; $this->seq_remove("_ALIAS_ $name"); delete $this->{alias}{$name}; return 1; } # Delete aliases with no members sub delempty { my $this = shift; my $count = 0; foreach my $name ($this->aliases) { unless ($this->alias($name)) { $this->delete($name); $count++; } } return $count; } # Add users to an existing alias sub add_user { my $this = shift; my $name = shift; my @aliases = ($name eq "*") ? $this->aliases : ($name); foreach (@aliases) { return 0 unless defined $this->{alias}{$_}; foreach my $user (@_) { $this->{alias}{$_}{$user} = 1; } } return 1; } # Remove users from an existing alias sub remove_user { my $this = shift; my $name = shift; my @aliases = ($name eq "*") ? $this->aliases : ($name); foreach (@aliases) { return 0 unless defined $this->{alias}{$_}; foreach my $user (@_) { delete $this->{alias}{$_}{$user}; } } return 1; } # Rename a user sub rename_user { my ($this, $oldname, $newname) = @_; my $count = 0; foreach ($this->aliases) { if (exists $this->{alias}{$_}{$oldname}) { delete $this->{alias}{$_}{$oldname}; $this->{alias}{$_}{$newname} = 1; $count++; } } return $count; } # Return the list of aliases sub aliases { my $this = shift; wantarray ? sort keys %{$this->{alias}} : keys %{$this->{alias}}; } # Add a comment before an alias sub comment { my ($this, $name, @cmnt) = @_; grep { chomp; s/$/\n/; } @cmnt; return $this->seq_insert("_ALIAS_ $name", @cmnt); } # Remove a comment sub uncomment { my ($this, $cmnt) = @_; chomp $cmnt; $cmnt =~ s/$/\n/; return $this->seq_remove($cmnt); } # Output file to disk sub write { my ($this, $fh) = @_; foreach my $seq ($this->sequence) { unless ($seq =~ /^_ALIAS_ ([^\s]+)$/) { print $fh $seq or return 0; next; } my $name = $1; my @users = $this->alias($name); next if !defined @users; print $fh $this->joinwrap(80, "$name: ", "\t", ",", ",", @users), "\n" or return 0; } return 1; } # Autoload methods go after =cut, and are processed by the autosplit program. 1; __END__ # Below is the stub of documentation for your module. You better edit it! =head1 NAME Unix::AliasFile - Perl interface to /etc/aliases format files =head1 SYNOPSIS use Unix::AliasFile; $al = new Unix::AliasFile "/etc/aliases"; $al->alias("bozos", @members); $al->delete("deadlist"); $al->remove_user("coolmail", "bgates", "badguy"); $al->add_user("coolmail", "joecool", "goodguy"); $al->remove_user("*", "deadguy"); $al->commit(); undef $al; =head1 DESCRIPTION The Unix::AliasFile module provides an abstract interface to Unix alias files. It automatically handles file locking, getting colons and commas in the right places, and all the other niggling details. Unlike some of the other Unix::*File modules, this module will preserve the order of your alias file, with a few exceptions. Comments and aliases will appear in the file in the same order that they started in, unless you have comment lines interspersed between the beginning of an alias and continuation lines for that same alias. In this case, those comments will appear after the alias that contains them. =head1 METHODS =head2 add_user( ALIAS, @USERS ) This method will add the list of users to an existing alias. Users that are already members of the alias are silently ignored. The special alias name * will add the users to every alias. Returns 1 on success or 0 on failure. =head2 alias( ALIAS [,@USERS] ) This method can add, modify, or return information about an alias. Supplied with a single alias parameter, it will return a list consisting of the members of that alias, or undef if no such alias exists. If you supply more parameters, the named alias will be created or modified if it already exists. The member list is also returned to you in this case. =head2 aliases( ) This method returns a list of all existing aliases. The list will be sorted in alphabetical order. In scalar context, this method returns the total number of aliases. =head2 comment( ALIAS, COMMENT ) This method inserts a comment line before the specified alias. You must supply your own comment marker (#) but a newline will be automatically appended to the comment unless it already has one. Returns 1 on success and 0 on failure. =head2 commit( [BACKUPEXT] ) See the Unix::ConfigFile documentation for a description of this method. =head2 delempty( ) This method will delete all existing aliases that have no members. It returns a count of how many aliases were deleted. =head2 delete( ALIAS ) This method will delete the named alias. It has no effect if the supplied alias does not exist. =head2 new( FILENAME [,OPTIONS] ) See the Unix::ConfigFile documentation for a description of this method. =head2 remove_user( ALIAS, @USERS ) This method will remove the list of users from an existing alias. Users that are not members of the alias are silently ignored. The special alias name * will remove the users from every alias. Returns 1 on success or 0 on failure. =head2 rename_user( OLDNAME, NEWNAME ) This method will change one username to another in every alias. Returns the number of aliases affected. =head2 uncomment( COMMENT ) Remove the comment from the file that matches the supplied text. The match must be exact. Returns 1 on success and 0 on failure. =head1 BUGS While the Unix::AliasFile module will work with Perl versions prior to 5.005, it may exhibit a minor bug under those versions. The bug will cause program aliases with embedded comma characters to be broken apart. This will not happen under 5.005 and up, due to the use of the Text::ParseWords module, which changed significantly with the 5.005 release. =head1 AUTHOR Steve Snodgrass, ssnodgra@fore.com =head1 SEE ALSO Unix::AutomountFile, Unix::ConfigFile, Unix::GroupFile, Unix::PasswdFile =cut return sort keys %{$this->{alias}{$name}}; } # Delete an aUnix-ConfigFile-0.06/aliases.orig010044400073060000165000000041700671362007000177530ustar00ssnodgrausers00002710000002#ident "@(#)aliases 1.13 92/07/14 SMI" /* SVr4.0 1.1 */ ## # Aliases can have any mix of upper and lower case on the left-hand side, # but the right-hand side should be proper case (usually lower) # # >>>>>>>>>> The program "newaliases" will need to be run after # >> NOTE >> this file is updated for any changes to # >>>>>>>>>> show through to sendmail. # # @(#)aliases 1.8 86/07/16 SMI ## # Following alias is required by the mail protocol, RFC 822 # Set it to the address of a HUMAN who deals with this system's mail problems. Postmaster: root # Alias for mailer daemon; returned messages from our MAILER-DAEMON # should be routed to our local Postmaster. MAILER-DAEMON: postmaster # Aliases to handle mail to programs or files, eg news or vacation # decode: "|/usr/bin/uudecode" nobody: /dev/null # Sample aliases: # Alias for distribution list, members specified here: staff:wnj,mosher,sam,ecc,mckusick,sklower,olson,rwh@ernie,bozon,bogon,bonon,test1,test2,test3, extent1,extent5,moretests, anothertest # Alias for distribution list, members specified elsewhere: #keyboards: :include:/usr/jfarrell/keyboards.list # Alias for a person, so they can receive mail by several names: #epa:eric ####################### # Local aliases below # ####################### root: ssnodgra abuse: postmaster webmaster: webdude # # Aliases for Majordomo mailing lists # majordomo: "|/usr/local/majordomo/wrapper majordomo" owner-majordomo: bigguy majordomo-owner: bigguy # Aliases for mylist-l list mylist-l: "|/usr/local/majordomo/wrapper resend -l mylist-l mylist-l-list" mylist-l-list: :include:/usr/local/majordomo/lists/mylist-l owner-mylist-l: bigguy,owner1,foobar mylist-l-request: "|/usr/local/majordomo/wrapper majordomo -l mylist-l" mylist-l-approval: bigguy # Aliases for yourlonglist-l list yourlonglist-l: "|/usr/local/majordomo/wrapper resend -l yourlonglist-l yourlonglist-l-list" yourlonglist-l-list: :include:/usr/local/majordomo/lists/yourlonglist-l owner-yourlonglist-l: bigguy,owner1,foobar yourlonglist-l-request: "|/usr/local/majordomo/wrapper majordomo -l yourlonglist-l" yourlonglist-l-approval: bigguy Unix-ConfigFile-0.06/examples/004075500073060000165000000000000710357700300172725ustar00ssnodgrausers00002710000002Unix-ConfigFile-0.06/examples/grouper.pl010075500073060000165000000020250710357231700213140ustar00ssnodgrausers00002710000002#!/usr/local/bin/perl -w # grouper.pl - Manipulate the group file # $Id: grouper.pl,v 1.1 1999/07/01 14:25:54 ssnodgra Exp $ use Unix::GroupFile; unless (@ARGV > 1) { print "Instructions:\n"; print "$0 -a group user ... Add users to group\n"; print "$0 -c group user ... Create new group\n"; print "$0 -r group user ... Remove users from group\n"; exit; } $grp = new Unix::GroupFile("/etc/group") or die "Can't open group file"; $option = shift; $group = shift; die "Bad group name: $group\n" unless $group =~ /^[a-z][a-z\d]{1,7}$/; if ($option eq "-a") { # Add users to group $grp->add_user($group, @ARGV) or die "Add failed\n"; } elsif ($option eq "-c") { die "Group $group already exists\n" if defined $grp->gid($group); $grp->group($group, "*", $grp->maxgid + 1, @ARGV); } elsif ($option eq "-r") { $grp->remove_user($group, @ARGV) or die "Remove failed\n"; } else { die "Bogus option $option\n"; } print "Rewriting group file...\n"; $grp->commit(backup => '~'); print "Done!\n"; Unix-ConfigFile-0.06/GroupFile.pm010044400073060000165000000233470710357562300177200ustar00ssnodgrausers00002710000002package Unix::GroupFile; # $Id: GroupFile.pm,v 1.6 2000/05/02 15:59:34 ssnodgra Exp $ use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use Unix::ConfigFile; require Exporter; @ISA = qw(Unix::ConfigFile Exporter); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw( ); $VERSION = '0.06'; # Package variables my $MAXLINELEN = 511; # Implementation Notes # # This module adds 3 new fields to the basic ConfigFile object. The fields # are 'gid', 'gpass', and 'group'. All three of these fields are hashes. # The gid field maps names to GIDs. The gpass field maps names to passwords. # The group fields maps GIDs to another hash of group members. There are # no real values in the group subhash, just a '1' as a placeholder. This is # a hash instead of a list because it makes duplicate elimination and user # deletion much easier to deal with. # Preloaded methods go here. # Read in the data structures from the supplied file sub read { my ($this, $fh) = @_; while (<$fh>) { chop; my ($name, $password, $gid, $users) = split /:/; my @users = split /,/, $users; if (defined $this->{group}{$gid}) { foreach (@users) { $this->{group}{$gid}{$_} = 1; } } else { $this->group($name, $password, $gid, @users); } } return 1; } # Add, modify, or get a group sub group { my $this = shift; my $name = shift; # If no more parameters, we return group info unless (@_) { my $gid = $this->gid($name); return undef unless defined $gid; return ($this->passwd($name), $gid, $this->members($name)); } # Create or modify a group return undef if @_ < 2; my $password = shift; my $gid = shift; # Have to be careful with this test - 0 is a legitimate return value return undef unless defined $this->gid($name, $gid); $this->passwd($name, $password); $this->members($name, @_); return ($gid, $password, $this->members($name)); } # Delete a group sub delete { my ($this, $name) = @_; my $gid = $this->gid($name); return 0 unless defined $gid; delete $this->{gpass}{$name}; delete $this->{group}{$gid}; delete $this->{gid}{$name}; return 1; } # Add users to an existing group sub add_user { my $this = shift; my $name = shift; my @groups = ($name eq "*") ? $this->groups : ($name); foreach (@groups) { my $gid = $this->gid($_); return 0 unless defined $gid; foreach my $user (@_) { $this->{group}{$gid}{$user} = 1; } } return 1; } # Remove users from an existing group sub remove_user { my $this = shift; my $name = shift; my @groups = ($name eq "*") ? $this->groups : ($name); foreach (@groups) { my $gid = $this->gid($_); return 0 unless defined $gid; foreach my $user (@_) { delete $this->{group}{$gid}{$user}; } } return 1; } # Rename a user sub rename_user { my ($this, $oldname, $newname) = @_; my $count = 0; foreach ($this->groups) { my $gid = $this->gid($_); if (exists $this->{group}{$gid}{$oldname}) { delete $this->{group}{$gid}{$oldname}; $this->{group}{$gid}{$newname} = 1; $count++; } } return $count; } # Return the list of groups # Accepts a sorting order parameter: gid or name (default gid) sub groups { my $this = shift; my $order = @_ ? shift : "gid"; return keys %{$this->{gid}} unless wantarray; if ($order eq "name") { return sort keys %{$this->{gid}}; } else { return sort { $this->gid($a) <=> $this->gid($b) } keys %{$this->{gid}}; } } # Returns the maximum GID in use in the file sub maxgid { my $this = shift; my @gids = sort { $a <=> $b } keys %{$this->{group}}; return pop @gids; } # Output the file to disk sub write { my ($this, $fh) = @_; foreach my $name ($this->groups) { my @users = $this->members($name); my $head = join(":", $name, $this->passwd($name), $this->gid($name), ""); my $ind = join(":", "$name%n", $this->passwd($name), $this->gid($name), ""); print $fh $this->joinwrap($MAXLINELEN, $head, $ind, ",", "", @users), "\n" or return 0; } return 1; } # Accessors (these all accept a group name and an optional value) sub passwd { my $this = shift; my $name = shift; @_ ? $this->{gpass}{$name} = shift : $this->{gpass}{$name}; } # Note that it is illegal to change a group's GID to one used by another group # This method also has to take into account side effects produced by doing # this, such as the fact that the member hash is keyed against the GID. sub gid { my $this = shift; my $name = shift; return $this->{gid}{$name} unless @_; my $newgid = shift; my $oldgid = $this->{gid}{$name}; # Return OK if you try to set the same GID a group already has return $oldgid if defined $oldgid && $newgid == $oldgid; return undef if grep { $newgid == $_ } values %{$this->{gid}}; if (defined $oldgid) { $this->{group}{$newgid} = $this->{group}{$oldgid}; delete $this->{group}{$oldgid}; } $this->{gid}{$name} = $newgid; } # Return or set the list of users in a group sub members { my $this = shift; my $name = shift; my $gid = $this->gid($name); return undef unless defined $gid; if (@_) { $this->{group}{$gid} = { }; $this->add_user($name, @_); } return keys %{$this->{group}{$gid}} unless wantarray; return sort keys %{$this->{group}{$gid}}; } # Autoload methods go after =cut, and are processed by the autosplit program. 1; __END__ # Below is the stub of documentation for your module. You better edit it! =head1 NAME Unix::GroupFile - Perl interface to /etc/group format files =head1 SYNOPSIS use Unix::GroupFile; $grp = new Unix::GroupFile "/etc/group"; $grp->group("bozos", "*", $grp->maxgid + 1, @members); $grp->remove_user("coolgrp", "bgates", "badguy"); $grp->add_user("coolgrp", "joecool", "goodguy"); $grp->remove_user("*", "deadguy"); $grp->passwd("bozos", $grp->encpass("newpass")); $grp->commit(); undef $grp; =head1 DESCRIPTION The Unix::GroupFile module provides an abstract interface to /etc/group format files. It automatically handles file locking, getting colons and commas in the right places, and all the other niggling details. This module also handles the annoying problem (at least on some systems) of trying to create a group line longer than 512 characters. Typically this is done by creating multiple lines of groups with the same GID. When a new GroupFile object is created, all members of groups with the same GID are merged into a single group with a name corresponding to the first name found in the file for that GID. When the file is committed, long groups are written out as multiple lines of no more than 512 characters, with numbers appended to the group name for the extra lines. =head1 METHODS =head2 add_user( GROUP, @USERS ) This method will add the list of users to an existing group. Users that are already members of the group are silently ignored. The special group name * will add the users to every group. Returns 1 on success or 0 on failure. =head2 commit( [BACKUPEXT] ) See the Unix::ConfigFile documentation for a description of this method. =head2 delete( GROUP ) This method will delete the named group. It has no effect if the supplied group does not exist. =head2 encpass( PASSWORD ) See the Unix::ConfigFile documentation for a description of this method. =head2 gid( GROUP [,GID] ) Read or modify a group's GID. Returns the GID in either case. Note that it is illegal to change a group's GID to a GID that is already in use by another group. In this case, the method returns undef. =head2 group( GROUP [,PASSWD, GID, @USERS] ) This method can add, modify, or return information about a group. Supplied with a single group parameter, it will return a list consisting of (PASSWORD, GID, @MEMBERS), or undef if no such group exists. If you supply at least three parameters, the named group will be created or modified if it already exists. The list is also returned to you in this case. Note that it is illegal to specify a GID that is already in use by another group. In this case, the method returns undef. =head2 groups( [SORTBY] ) This method returns a list of all existing groups. By default the list will be sorted in order of the GIDs of the groups. You may also supply "name" as a parameter to the method to get the list sorted by group name. In scalar context, this method returns the total number of groups. =head2 maxgid( ) This method returns the maximum GID in use by all groups. =head2 members( GROUP [,@USERS] ) Read or modify the list of members associated with a group. If you specify any users when you call the method, all existing members of the group are removed and your list becomes the new set of members. In scalar context, this method returns the total number of members in the group. =head2 new( FILENAME [,OPTIONS] ) See the Unix::ConfigFile documentation for a description of this method. =head2 passwd( GROUP [,PASSWD] ) Read or modify a group's password. Returns the encrypted password in either case. If you have a plaintext password, use the encpass method to encrypt it before passing it to this method. =head2 remove_user( GROUP, @USERS ) This method will remove the list of users from an existing group. Users that are not members of the group are silently ignored. The special group name * will remove the users from every group. Returns 1 on success or 0 on failure. =head2 rename_user( OLDNAME, NEWNAME ) This method will change one username to another in every group. Returns the number of groups affected. =head1 AUTHOR Steve Snodgrass, ssnodgra@fore.com =head1 SEE ALSO Unix::AliasFile, Unix::AutomountFile, Unix::ConfigFile, Unix::PasswdFile =cut Unix-ConfigFile-0.06/passwd.test010044400073060000165000000005170670544636700176730ustar00ssnodgrausers00002710000002root:x:0:10:Charlie root:/:/bin/csh daemon:x:1:31:Mr Background:/: bin:x:2:100:System and local source:/bin:/bin/csh sys:x:3:3:Mr Kernel:/:/bin/csh adm:x:4:14:Adm account:/usr/adm:/bin/csh lp:x:71:100:Line Printer Account:/usr/lib/lp: test:*:2112:2048:Testy Test:/home/test:/bin/ksh nobody:x:60001:60001:Unprivileged user:/:/bin/false