зеркало из https://github.com/mozilla/gecko-dev.git
279 строки
7.0 KiB
Perl
279 строки
7.0 KiB
Perl
#############################################################################
|
|
# $Id: Utils.pm,v 1.6 1998/07/30 09:18:38 leif Exp $
|
|
#
|
|
# The contents of this file are subject to the Mozilla Public License
|
|
# Version 1.0 (the "License"); you may not use this file except in
|
|
# compliance with the License. You may obtain a copy of the License at
|
|
# http://www.mozilla.org/MPL/
|
|
#
|
|
# Software distributed under the License is distributed on an "AS IS"
|
|
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
|
|
# License for the specific language governing rights and limitations
|
|
# under the License.
|
|
#
|
|
# The Original Code is PerlDAP. The Initial Developer of the Original
|
|
# Code is Netscape Communications Corp. and Clayton Donley. Portions
|
|
# created by Netscape are Copyright (C) Netscape Communications
|
|
# Corp., portions created by Clayton Donley are Copyright (C) Clayton
|
|
# Donley. All Rights Reserved.
|
|
#
|
|
# Contributor(s):
|
|
#
|
|
# DESCRIPTION
|
|
# Lots of Useful Little Utilities, for LDAP related operations.
|
|
#
|
|
#############################################################################
|
|
|
|
package Mozilla::LDAP::Utils;
|
|
|
|
use Mozilla::LDAP::API qw(:constant);
|
|
use Mozilla::LDAP::Conn;
|
|
use vars qw(@ISA %EXPORT_TAGS);
|
|
|
|
require Exporter;
|
|
|
|
@ISA = qw(Exporter);
|
|
%EXPORT_TAGS = (
|
|
all => [qw(normalizeDN
|
|
isUrl
|
|
printEntry
|
|
printentry
|
|
encodeBase64
|
|
decodeBase64
|
|
str2Scope
|
|
askPassword
|
|
ldapArgs
|
|
unixCrypt
|
|
userCredentials)]
|
|
);
|
|
|
|
|
|
# Add Everything in %EXPORT_TAGS to @EXPORT_OK
|
|
Exporter::export_ok_tags('all');
|
|
|
|
|
|
#############################################################################
|
|
# Normalize the DN string (first argument), and return the new, normalized,
|
|
# string (DN). This is useful to make sure that two syntactically
|
|
# identical DNs compare (eq) as the same string.
|
|
#
|
|
sub normalizeDN
|
|
{
|
|
my ($self, $dn) = @_;
|
|
my (@vals);
|
|
|
|
$dn = $self->{dn} unless $dn;
|
|
return "" if ($dn eq "");
|
|
|
|
$vals = Mozilla::LDAP::API::ldap_explode_dn(lc $dn, 0);
|
|
|
|
return join(",", @{$vals});
|
|
}
|
|
|
|
|
|
#############################################################################
|
|
# Checks if a string is a properly formed LDAP URL.
|
|
#
|
|
sub isURL
|
|
{
|
|
return ldap_is_ldap_url($_[0]);
|
|
}
|
|
|
|
|
|
#############################################################################
|
|
# Print an entry, in LDIF format. This is sort of obsolete, we encourage
|
|
# you to use the :;LDAP::LDIF class instead.
|
|
#
|
|
sub printEntry
|
|
{
|
|
my $entry = $_[0];
|
|
my $attr;
|
|
local $_;
|
|
|
|
print "dn: ", $entry->{dn},"\n";
|
|
foreach $attr (@{$entry->{_oc_order_}})
|
|
{
|
|
next if ($attr =~ /^_.+_$/);
|
|
next if $entry->{"_${attr}_deleted_"};
|
|
foreach (@{$entry->{$attr}})
|
|
{
|
|
print "$attr: $_\n";
|
|
}
|
|
}
|
|
|
|
print "\n";
|
|
}
|
|
*printentry = \*printEntry;
|
|
|
|
|
|
#############################################################################
|
|
# Perform Base64 encoding, this is based on MIME::Base64.pm, written
|
|
# by Gisle Aas <gisle@aas.no>. If possible, use the MIME:: package instead.
|
|
#
|
|
sub encodeBase64
|
|
{
|
|
my $res = "";
|
|
my $eol = "$_[1]";
|
|
my $padding;
|
|
|
|
pos($_[0]) = 0; # ensure start at the beginning
|
|
while ($_[0] =~ /(.{1,45})/gs) {
|
|
$res .= substr(pack('u', $1), 1);
|
|
chop($res);
|
|
}
|
|
|
|
$res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs
|
|
$padding = (3 - length($_[0]) % 3) % 3;
|
|
$res =~ s/.{$padding}$/'=' x $padding/e if $padding;
|
|
|
|
if (length $eol) {
|
|
$res =~ s/(.{1,76})/$1$eol/g;
|
|
}
|
|
|
|
return $res;
|
|
}
|
|
|
|
|
|
#############################################################################
|
|
# Perform Base64 decoding, this is based on MIME::Base64.pm, written
|
|
# by Gisle Aas <gisle@aas.no>. If possible, use the MIME:: package instead.
|
|
#
|
|
sub decodeBase64
|
|
{
|
|
my $str = shift;
|
|
my $res = "";
|
|
my $len;
|
|
|
|
$str =~ tr|A-Za-z0-9+=/||cd;
|
|
Carp::croak("Base64 decoder requires string length to be a multiple of 4")
|
|
if length($str) % 4;
|
|
|
|
$str =~ s/=+$//; # remove padding
|
|
$str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format
|
|
while ($str =~ /(.{1,60})/gs)
|
|
{
|
|
$len = chr(32 + length($1)*3/4);
|
|
$res .= unpack("u", $len . $1 ); # uudecode
|
|
}
|
|
|
|
return $res;
|
|
}
|
|
|
|
|
|
#############################################################################
|
|
# Convert a "human" readable string to an LDAP scope value
|
|
#
|
|
sub str2Scope
|
|
{
|
|
my $str = $_[0];
|
|
|
|
return $str if ($str =~ /^[0-9]+$/);
|
|
|
|
if ($str =~ /^sub/i)
|
|
{
|
|
return LDAP_SCOPE_SUBTREE;
|
|
}
|
|
elsif ($str =~ /^base/i)
|
|
{
|
|
return LDAP_SCOPE_BASE;
|
|
}
|
|
elsif ($str =~ /^one/i)
|
|
{
|
|
return LDAP_SCOPE_ONELEVEL;
|
|
}
|
|
|
|
# Default...
|
|
return LDAP_SCOPE_SUBTREE;
|
|
}
|
|
|
|
|
|
#################################################################################
|
|
# Ask for a password, without displaying it on the TTY. This is very non-
|
|
# portable, we need a better solution (using the term package perhaps?).
|
|
#
|
|
sub askPassword
|
|
{
|
|
system('/bin/stty -echo');
|
|
chop($_ = <STDIN>);
|
|
system('/bin/stty echo');
|
|
print "\n";
|
|
|
|
return $_;
|
|
}
|
|
|
|
|
|
#################################################################################
|
|
# Handle some standard LDAP options, and construct a nice little structure that
|
|
# we can use later on.
|
|
#
|
|
sub ldapArgs
|
|
{
|
|
my($bind, $base) = @_;
|
|
my(%ld);
|
|
|
|
$main::opt_v = $main::opt_n if $main::opt_n;
|
|
$main::opt_p = LDAPS_PORT unless ($main::opt_p || ($main::opt_P eq ""));
|
|
|
|
$ld{host} = $main::opt_h || "ldap";
|
|
$ld{port} = $main::opt_p || LDAP_PORT;
|
|
$ld{root} = $main::opt_b || $base || $ENV{'LDAP_BASEDN'};
|
|
$ld{bind} = $main::opt_D || $bind || "";
|
|
$ld{pswd} = $main::opt_w || "";
|
|
$ld{cert} = $main::opt_P || "";
|
|
$ld{scope} = $main::opt_s || LDAP_SCOPE_SUBTREE;
|
|
|
|
if (($ld{bind} ne "") && ($ld{pswd} eq ""))
|
|
{
|
|
print "LDAP password: ";
|
|
$ld{pswd} = askPassword();
|
|
}
|
|
|
|
return %ld;
|
|
}
|
|
|
|
|
|
#################################################################################
|
|
# Create a Unix-type password, using the "crypt" function. A random salt
|
|
# is always generated, perhaps it should be an optional argument?
|
|
#
|
|
sub unixCrypt
|
|
{
|
|
my $ascii =
|
|
"./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
|
|
my $salt = substr($ascii, rand(62), 1) . substr($ascii, rand(62), 1);
|
|
|
|
srand(time ^ $$);
|
|
crypt($_[0], $salt);
|
|
}
|
|
|
|
|
|
#############################################################################
|
|
# Try to find a user to bind as, and possibly ask for the password. Pass
|
|
# a pointer to the hash array with parameters to this function.
|
|
#
|
|
sub userCredentials
|
|
{
|
|
my ($ld) = @_;
|
|
my ($conn, $entry, $pswd);
|
|
|
|
if ($ld->{bind} eq "")
|
|
{
|
|
$conn = new Mozilla::LDAP::Conn($ld);
|
|
die "Could't connect to LDAP server $ld->{host}" unless $conn;
|
|
|
|
$search = "(&(objectclass=inetOrgPerson)(uid=$ENV{USER}))";
|
|
$entry = $conn->search($ld->{root}, "subtree", $search, 0, ("uid"));
|
|
return 0 if (!$entry || $conn->nextEntry());
|
|
|
|
$conn->close();
|
|
$ld->{bind} = $entry->getDN();
|
|
print "Binding as $ld->{bind}\n\n" if $main::opt_v;
|
|
}
|
|
|
|
if ($ld->{pswd} eq "")
|
|
{
|
|
print "Enter bind password: ";
|
|
$ld->{pswd} = Mozilla::LDAP::Utils::askPassword();
|
|
}
|
|
}
|