diff options
Diffstat (limited to 'ldap/admin/src/DSAdmin.pm')
| -rw-r--r-- | ldap/admin/src/DSAdmin.pm | 225 |
1 files changed, 225 insertions, 0 deletions
diff --git a/ldap/admin/src/DSAdmin.pm b/ldap/admin/src/DSAdmin.pm new file mode 100644 index 00000000..a8578a32 --- /dev/null +++ b/ldap/admin/src/DSAdmin.pm @@ -0,0 +1,225 @@ +# +# BEGIN COPYRIGHT BLOCK +# Copyright 2001 Sun Microsystems, Inc. +# Portions copyright 1999, 2001-2003 Netscape Communications Corporation. +# All rights reserved. +# END COPYRIGHT BLOCK +# + +package DSAdmin; + +use POSIX; + +use strict; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD +$isNT $PATHSEP $quote $script_suffix $exe_suffix $os +$dll_suffix $argumentative @args $first $rest $errs $pos +); + +require Exporter; +require DynaLoader; +require AutoLoader; + +@ISA = qw(Exporter DynaLoader); +# 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. + +# 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( + normalizeDN toLocal toUTF8 +); +$VERSION = '1.00'; + +bootstrap DSAdmin $VERSION; + +BEGIN { + require 'uname.lib'; + $isNT = -d '\\'; +# @INC = ( '.', '../../../admin/admin/bin' ); +# grep { s@/@\\@g } @INC if $isNT; + $PATHSEP = $isNT ? '\\' : '/'; + # NT needs quotes around some things unix doesn't + $quote = $isNT ? "\"" : ""; + + $script_suffix = $isNT ? ".bat" : ""; + $exe_suffix = $isNT ? ".exe" : ""; + if ($isNT) { + $os = "WINNT"; + } else { + $os = &uname("-s"); + } + + # dll suffix for shared libraries in old instance; note that the dll suffix + # may have changed for the new instance e.g. AIX now uses .so + if ( $os eq "AIX" ) { + $dll_suffix = "_shr.a"; + } + elsif ( $os eq "HP-UX" ) { + $dll_suffix = ".sl"; + } + elsif ( $os eq "WINNT" ) { + $dll_suffix = ".dll"; + } + else { + $dll_suffix = ".so"; + } +} + +sub getCwd { + my $command = $isNT ? "cd" : "/bin/pwd"; + open(PWDCMD, "$command 2>&1 |") or + die "Error: could not execute $command: $!"; + # without the following sleep, reading from the pipe will + # return nothing; I guess it gives the pwd command time + # to get some data to read . . . + sleep(1); + my $curdir; + while (<PWDCMD>) { + if (!$curdir) { + chomp($curdir = $_); + } + } + my $code = close(PWDCMD); +# if ($code || $?) { +# print "$command returned code=$code status=$? dir=$curdir\n"; +# } +# print "getCwd curdir=\[$curdir\]\n"; + return $curdir; +} + +# this is used to run the system() call, capture exit and signal codes, +# and die() upon badness; the first argument is a directory to change +# dir to, if any, and the rest are passed to system() +sub mySystem { + my $rc = &mySystemNoDie(@_); + my ($dir, @args) = @_; + if ($rc == 0) { +# success + } elsif ($rc == 0xff00) { + die "Error executing @args: error code $rc: $!"; + } elsif ($rc > 0x80) { + $rc >>= 8; + die "Error executing @args: error code $rc: $!"; + } else { + if ($rc & 0x80) { + $rc &= ~0x80; + } + die "Error executing @args: received signal $rc: $!"; + } + + # usually won't get return value + return $rc; +} + +# This version does not die but just returns the error code +sub mySystemNoDie { + my ($dir, @args) = @_; + if ($dir && ($dir ne "")) { + chdir($dir) or die "Could not change directory to $dir: $!"; + } + my $cmd = $args[0]; + # the system {$cmd} avoids some NT shell quoting problems if the $cmd + # needs to be quoted e.g. contains spaces; the map puts double quotes + # around the arguments on NT which are stripped by the command + # interpreter cmd.exe; but don't quote things which are already quoted + my @fixargs = map { /^[\"].*[\"]$/ ? $_ : $quote . $_ . $quote } @args; + my $rc = 0; + if ($cmd =~ /[.](bat|cmd)$/) { + # we have to pass batch files directly to the NT command interpreter + $cmd = $ENV{COMSPEC}; + if (!$cmd) { + $cmd = 'c:\winnt\system32\cmd.exe'; + } +# print "system $cmd /c \"@fixargs\"\n"; + $rc = 0xffff & system {$cmd} '/c', "\"@fixargs\""; + } else { + print "system $cmd @fixargs\n"; + $rc = 0xffff & system {$cmd} @fixargs; + } + return $rc; +} + +sub getTempFileName { + my $tmp = tmpnam(); + while (-f $tmp) { + $tmp = tmpnam(); + } + + return $tmp; +} + +sub getopts { + local($argumentative) = @_; + local(@args,$_,$first,$rest); + local($errs) = 0; + local($[) = 0; + + @args = split( / */, $argumentative ); + while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) { + ($first,$rest) = ($1,$2); + $pos = index($argumentative,$first); + if($pos >= $[) { + if($args[$pos+1] eq ':') { + shift(@ARGV); + if($rest eq '') { + ++$errs unless @ARGV; + $rest = shift(@ARGV); + } + eval "\$main::opt_$first = \$rest;"; + } + else { + eval "\$main::opt_$first = 1"; + if($rest eq '') { + shift(@ARGV); + } + else { + $ARGV[0] = "-$rest"; + } + } + } + else { + print STDERR "Unknown option: $first\n"; + ++$errs; + if($rest ne '') { + $ARGV[0] = "-$rest"; + } + else { + shift(@ARGV); + } + } + } + $errs == 0; +} + +# 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 + +DSAdmin - Perl extension for directory server administrative utility functions + +=head1 SYNOPSIS + + use DSAdmin; + +=head1 DESCRIPTION + +The DSAdmin module is used by directory server administration scripts, such as +those used for installation/uninstallation, instance creation/removal, CGIs, +etc. + +=head1 AUTHOR + +Richard Megginson richm@netscape.com + +=head1 SEE ALSO + +perl(1). + +=cut |