#!/usr/bin/perl -w
#
# $Id: passwd2ldif.pl,v 1.13 2003/01/13 05:28:42 jmates Exp $
#
# Copyright (c) 2001, Jeremy Mates.  This script is free software;
# you can redistribute it and/or modify it under the same terms as
# Perl itself.
#
# Run perldoc(1) on this file for additional documentation.
#
######################################################################
#
# REQUIREMENTS

require 5;

use strict;

######################################################################
#
# MODULES

use Carp;           # better error reporting
use Getopt::Std;    # command line option processing

######################################################################
#
# VARIABLES

my $VERSION;
($VERSION = '$Revision: 1.13 $ ') =~ s/[^0-9.]//g;

# data is a hash of hash, keyed off username, subhash account details
my (%opts, $data);

# for command line options...
my ($dn, $alias_file, $spool_dir);

######################################################################
#
# MAIN

# parse command-line options
getopts('h?d:a:s:', \%opts);

help() if exists $opts{'h'} or exists $opts{'?'};

$dn = $opts{'d'} if exists $opts{'d'};

$alias_file = $opts{'a'} if exists $opts{'a'};

if (exists $opts{'s'}) {
    die "spool dir $opts{s} not a directory\n" unless -d $opts{'s'};
    $spool_dir = $opts{'s'};
}

# extract password data into data structure, as also have to
# mumble over the mail information...
while (
    my (
         $name,    $passwd, $uid, $gid,   $quota,
         $comment, $gcos,   $dir, $shell, $expire
    )
    = getpwent()
  ) {

    $data->{$name}->{uid} = $name;

    # default to crypt, but also handle md5 ($1$),
    # blowfish ($2$) crypts in RFC 2307 fashion
    my $pw_hash = 'crypt';
    $pw_hash = 'md5'       if q/$1$/ eq substr $passwd, 0, 3;
    $pw_hash = 'altscheme' if q/$2$/ eq substr $passwd, 0, 3;

    $data->{$name}->{userpassword} = "{$pw_hash}$passwd";

    $data->{$name}->{uidnumber} = $uid;
    $data->{$name}->{gidnumber} = $gid;

    # pull out additional stuff from gcos field (HACK)
    # (this is due to inconsistent usage of , data in the password
    # files I'm dealing with...)
    $gcos =~ s/,(.+)//;
    my ($gcos_extra) = $1;

    $data->{$name}->{cn}        = $gcos;
    $data->{$name}->{gcosextra} = $gcos_extra if $gcos_extra;

    $data->{$name}->{homedirectory} = $dir;
    $data->{$name}->{loginshell}    = $shell;

    # deal with the other fields as required...
    # (again, a site-specific detail, especially quota n' similar)

    # .forward data mining
    # assumption: confFORWARD_PATH hasn't been mucked with
    if (-f "$dir/.forward") {
        unless (open FWRD, "$dir/.forward") {
            warn "Problem opening $dir/.forward: $!\n";
        } else {
            while (<FWRD>) {
                chomp;
                next if /^#/;
                s/^\s+//;
                s/\s+$//;
                next if /^$/;

                push @{$data->{$name}->{forward}}, $_;
            }
            close FWRD;
        }
    }

    # if have a .procmailrc, might be doing funny things with mail
    if (-e "$dir/.procmailrc") {
        $data->{$name}->{procmailrc} = "yes";
    }

    # checks on mail spool for various data
    if ($spool_dir) {
        if (-f "$spool_dir/$name") {
            $data->{$name}->{mailspool} = "$spool_dir/$name";

            my ($size, $atime, $mtime) = (stat _)[7 .. 9];

            $data->{$name}->{mailspoolsize} = $size;
            $data->{$name}->{mailspooldate} = $mtime;
        }
    }
}

# deal w/ aliases
if ($alias_file) {
    for my $file (split /,/, $alias_file) {
        unless (open FILE, $file) {
            warn "Problem opening $file: $!\n";
            next;
        } else {

            # light-weight aliases parser...
            # (does not handle multi-line aliases)
            while (<FILE>) {
                chomp;
                next if /^#/;
                s/^\s+//;
                s/\s+$//;
                next if /^$/;

                my ($lhs, $rhs) = split /\s*:\s*/, $_, 2;
                if (exists $data->{$lhs}) {
                    push @{$data->{$lhs}->{alias}}, $rhs;
                }
            }
            close FILE;
        }
    }
}

for my $entry (sort keys %$data) {
    print "dn: cn=", $data->{$entry}->{cn}, ",$dn\n" if $dn;

    for my $key (sort keys %{$data->{$entry}}) {
        if (ref $data->{$entry}->{$key} eq 'ARRAY') {
            for (@{$data->{$entry}->{$key}}) {
                print $key, ": ", $_, "\n";
            }
        } else {
            print $key, ": ", $data->{$entry}->{$key}, "\n";
        }
    }

    print "\n";
}

exit;

######################################################################
#
# SUBROUTINES

# a generic help blarb
sub help {
    print <<"HELP";
Usage: $0 [opts]

Produces LDIF output from unix system accounts and sendmail data.

Options for version $VERSION:
  -h/-?  Display this message

  -d dn  Use specified dn in output. (Default: no dn entry.)

  -a al  List of aliases files to read in (Comma separated)
  -s dir Use specified dir to read mail spool information from.
         (e.g. -s /var/mail on BSD systems)

Run perldoc(1) on this script for additional documentation.

HELP
    exit;
}

######################################################################
#
# DOCUMENTATION

=head1 NAME

passwd2ldif.pl - converts system passwd/mail data into LDIF records

=head1 SYNOPSIS

  $ passwd2ldif.pl -d 'ou=people,dc=example,dc=org'

=head1 DESCRIPTION

=head2 Overview

Produces RFC 2307-ish LDIF records to STDOUT using data gained from
the getpwent() function call, in (optionally) addition to the Sendmail
aliases, .forward, and mail spool records.

=head2 Normal Usage

  $ passwd2ldif.pl [options]

See L<"OPTIONS"> for details on the command line switches supported.

=head1 OPTIONS

This script currently supports the following command line switches:

=over 4

=item B<-h>, B<-?>

Prints a brief usage note about the script.

=item B<-d>, I<dn>

Include a C<dn:> line, with the specified distinguished name data
I<dn> appended to the group name.

=item B<-a>, I<aliasfile>

Attempt to glean forwarding information from I<aliasfile>.  If the
system has multiple alias files, separate them with commas:

  -a /etc/mail/aliases,/etc/mail/extra-aliases

=item B<-s>, I<spooldir>

Attempt to glean information from the specified mail spool directory.
This is usually C</var/spool/mail> or C</var/mail> on common unix
systems these days.

=back

=head1 ENVIRONMENT

Relies on system returning "reasonable" data from the getpwent()
function-- should work properly on unix systems.  Unknown what will
happen under MacPerl (on pre-X Mac OS) or ActiveState Perl (for legacy
Microsoft OS).

The garnering of mail data is sendmail-specific, and may need to be
adjusted for wacky installs of sendmail and/or alternative mailers.

=head1 BUGS

=head2 Reporting Bugs

Newer versions of this script may be available from:

http://sial.org/code/perl/

If the bug is in the latest version, send a report to the author.
Patches that fix problems or add new features are welcome.

=head2 Known Issues

No known bugs.

=head1 SEE ALSO

perl(1), RFC 2307, RFC 2849

=head1 AUTHOR

Jeremy Mates, http://sial.org/contact/

=head1 COPYRIGHT

Copyright (c) 2001, Jeremy Mates.  This script is free software;
you can redistribute it and/or modify it under the same terms as Perl
itself.

=head1 VERSION

  $Id: passwd2ldif.pl,v 1.13 2003/01/13 05:28:42 jmates Exp $

=cut