#!/usr/bin/perl
# ldapextras.pl
# version 0.11
# licensed under the LGPL - see http://www.gnu.org
# Jules Agee
# August 17 2001
# configuration options need to be defined in ldapextras.conf

sub ldapextras {
    $userisadmin = 1 if( $uid eq $manageruid );
    for( $op ) {
        /ldapsearch/	and do { undef $gomodifyit; ldapsearch();  last; };
        /printuser/	and do { undef $gomodifyit; printuser();   last; };
        /printgroup/	and do { undef $gomodifyit; printgroup();  last; };
        /createuser/	and do { undef $gomodifyit; createuser();  last; };
        /creategroup/	and do { undef $gomodifyit; creategroup(); last; };
        /changeuser/	and do { undef $gomodifyit; changeuser();  last; };
        /changegroup/	and do { undef $gomodifyit; changegroup(); last; };
        /deleteuser/	and do { undef $gomodifyit; deleteuser();  last; };
        /deletegroup/	and do { undef $gomodifyit; deletegroup(); last; };
    }    
    return;
}


# Parses form data from the printuser HTML form when the op parameter
# is set to createuser, and creates a new INBOX and Trash folder,
# then creates an LDAP entry
sub createuser {
    checkbuttons();

    if( !$userisadmin ) {
        autherr();
        return;
    }
    
    # make sure the admin filled out at least the minimum number of fields to
    # successfully create an account
    my %reqatts = ( 'sn'=>'Last Name',
                    'givenname'=>'First Name',
                    'pass1'=>'Password',
                    'pass2'=>'Password (again)',
                    'ldapuid'=>'Employee UID'
                  );
    while( my( $att, $desc ) = each %reqatts ) {
        if( param( $att ) eq '' ) {
            printerr("\"$desc\" is a required field. Try again.");
            printuser();
            return;
        }
    }
    
    if( param( 'pass1' ) ne param( 'pass2' )) {
        printerr("Password fields don't match. Try again.");
        printuser();
        return;
    }

    # Get the new users data from the submitted HTML form
    my $ldapuid = param( 'ldapuid' );
    my $mail = $ldapuid . "\@" . $maildomain;
    my $cn = param( 'givenname' ) ." ". param( 'sn' ) ." (". $ldapuid .")";
    my $dn = "cn=" . $cn . "," . $ldapperson_ou;
    param( 'dn', $dn );

    # create their mailboxes
    $imap = openimap( $uid, $pass, $imapserver, $imapport, $useimapSSL );
    my $err = createmailfolder( "user." . $ldapuid );
    if( $err ) {
        printerr( "createuser: imaperr $err" );
        return;
    }
    $err = createmailfolder( "user." . $ldapuid . ".Trash" );
    if( $err ) {
        printerr( "createuser: imaperr $err" );
        return;
    }
    closeimap();

    $ldap = ldapbind();
    return if $ldap < 0;

    # here we're using the default LDAP atts array to start making a 
    # complete set of attributes for one user
    my $ldapentry = Net::LDAP::Entry->new;

    $ldapentry->dn( $dn );
    $ldapentry->add( %ldappersondefatts );
    $ldapentry->add( 'cn'=> $cn,
                     'uid'=> $ldapuid,
                     'mail'=> $mail,
                     'sn' => param( 'sn' ),
                     'givenname'=> param( 'givenname' ),
                     'mailHost'=> $imapserver,
                     $ldappassattr=>encrypt( param( 'pass1' ))
                   );

    # All possible entries for the @ldappersonatts array are defined
    # in the ldapextras.conf file, with the odd elements naming an LDAP attrib.
    # Or, the even elements, depending how you look at it. The first, third
    # and fifth elements of the array, or array index values 0, 2, 4...
    # In the loop below, for every @ldappersonatts attribute that is
    # defined in an HTML param in the current environment, we want to add
    # the name of the attribute and the value of its corresponding HTML param
    # to the $ldapentry object so we can just call $ldapentry->update to create
    # the user's directory entry
    
    for( $i = 0; $i < $#ldappersonatts; $i += 2 ) { 
        my $key = $ldappersonatts[ $i ];
        my $value = param( $key );
        if( $value ) {
            $ldapentry->add( $key => $value );
        }
    }

    my $result = $ldapentry->update( $ldap );

    if( $result->code ) {
        printerr( "createuser: error creating LDAP entry:". $result->error);
    } else {
        print "User ", param( 'cn' ), 
              " directory entry created successfully.<BR>";
    }
    $ldap->unbind;
    param( 'entrytype', 'user' );
    print hidden( 'entrytype' );
    printuser();
    return; 
}


# Parses form data from the printgroup HTML form when the op parameter
# is set to creategroup, and creates a new LDAP entry for that group
sub creategroup {
    checkbuttons();

    if( !$userisadmin ) {
        autherr();
        return();
    }

    my $cn = param( 'cn' );
    my $dn = "cn=" . $cn . "," . $ldapgroup_ou;
    my $mail = $cn . "\@" . $maildomain;

    my $ldap = ldapbind();
    return if $ldap < 0;

    # @memberDNs is a list of the DNs of entries we are adding to this group

    my @memberDNs;
    my @memberarray = split( '\n', param( 'memberchanges' ));
    my $filter = "(|";

    # for performance reasons we don't want to perform a separate search
    # for every DN in the group, so we'll build a search filter that will
    # only capture these DNs.
    for( @memberarray ) {
        chop;
        $filter .= "(cn=$_)(uid=$_)";
    }
    $filter .= ")";

    $mesg = $ldap->search( base=>$LDAP_BASEDN,
                           filter=>$filter,
                           attrs=>[ "uid", "cn", "objectClass" ]
                         );

    printerr("creategroup:" . $mesg->error) if( $mesg->code );
    @entries = $mesg->entries;
    for( @entries ) {
        push( @memberDNs, $_->dn() );
    }

    # here we're using the default LDAP atts array to start making a 
    # complete set of attributes for one group
    my $ldapentry = Net::LDAP::Entry->new;

    $ldapentry->dn( $dn );
    $ldapentry->add( %ldapgroupdefatts );
    $ldapentry->add( 'cn'=> $cn,
                     'mail'=> $mail,
                     $ldapmemberatt=>\@memberDNs
                   );

    my $result = $ldapentry->update( $ldap );

    if( $result->code ) {
        printerr( "creategroup: error creating LDAP entry:". $result->error);
    } else {
        print "Group ", param( 'cn' )," created successfully in directory.<BR>";
    }
    $ldap->unbind;
    param( 'dn', $dn );
    param( 'entrytype', 'group' );
    print hidden( 'entrytype' );
    printgroup();
    return; 
}


# Parses form data from the printuser HTML form when the ldapaction parameter
# is set to changeuser, and makes changes to the user's LDAP directory entry and
# their quotas if necessary
sub changeuser {
    checkbuttons();

    if( !$userisadmin ) {
        autherr();
        return;
    }
    my $pass1 = param( 'pass1' );
    my $pass2 = param( 'pass2' );

    if( $pass1 ne $pass2 ) {
        printerr("Password fields don't match. Try again.");
        printuser();
        return;
    }

    my $ldapuid = param( 'ldapuid' );

    # set new maxquota value

    my $maxquota = param( 'maxquota' );
    $imap = openimap( $uid, $pass, $imapserver, $imapport, $useimapSSL );
    my $err = setquota( "user.$ldapuid", $maxquota );
    closeimap();

    my $ldap = ldapbind();
    my $dn = param( 'dn' );

    # get the existing entry for this user from the directory
    $ldapentry = ldapget( $ldap, $dn );

    # and update it with the new data
    for( $i = 0; $i < $#ldappersonatts; $i += 2 ) {
        $ldapentry->replace( $ldappersonatts[ $i ]=>
                             param( $ldappersonatts[ $i ] ));
    }
   
    # change password if necessary
    if( $pass1 && $pass1 ne "" ) {
        $ldapentry->replace( $ldappassattr=>encrypt( $pass1 ));
    }

    # and dump it all back onto the server
    my $result = $ldapentry->update( $ldap );

    if( $result->code ) {
        printerr( "changeuser: error changing LDAP entry:". $result->error);
    } else {
        print "User ", param( 'cn' )," updated successfully.<BR>";
    }

    $ldap->unbind;
    undef $ldap;
    print hidden( 'entrytype', 'user' );
    printuser();
    return;
}


# Parses form data from the printgroup HTML form when the op parameter
# is set to changegroup, and makes changes to that group's directory entry
sub changegroup {
    checkbuttons();

    if( !$userisadmin ) {
        autherr();
        return;
    }

    my $dn = param( 'dn' );

    my $ldap = ldapbind();
    return if $ldap < 0;

    # @memberDNs is a list of the DNs of entries in this group

    my @memberDNs;
    my @memberarray = split( '\n', param( 'memberchanges' ));
    my $filter = "(|";

    # for performance reasons we don't want to perform a separate search
    # for every DN in the group, so we'll build a search filter that will
    # capture all the DNs in one search.
    for( @memberarray ) {
        chop;
        $filter .= "(cn=$_)(uid=$_)";
    }
    $filter .= ")";

    $mesg = $ldap->search( base=>$LDAP_BASEDN,
                           filter=>$filter,
                           attrs=>[ "uid", "cn", "objectClass" ]
                         );

    printerr("changegroup:" . $mesg->error) if( $mesg->code );
    @entries = $mesg->entries;
    for( @entries ) {
        push( @memberDNs, $_->dn() );
    }

    # get the existing entry for this group from the directory
    $ldapentry = ldapget( $ldap, $dn );

    # and update it with the new list of members
    $ldapentry->replace( $ldapmemberatt=>\@memberDNs );
    my $result = $ldapentry->update( $ldap );

    if( $result->code ) {
        printerr( "changegroup: error changing LDAP entry:". $result->error);
    } else {
        print "Group ", param( 'cn' )," updated successfully.<BR>";
    }
    $ldap->unbind;
    param( 'dn', $dn );
    param( 'entrytype', 'group' );
    print hidden( 'entrytype' );
    printgroup();
    return; 
}


# Parses form data from the confirmdelete HTML form and deletes that user's
# LDAP entry and IMAP mailboxes. Also deletes references to that user from
# all mail groups.
sub deleteuser {

    if( !$userisadmin ) {
        autherr();
        return;
    }
    $imap = openimap( $uid, $pass, $imapserver, $imapport, $useimapSSL );
    my $err = setacl( "user." . param( 'ldapuid' ), 
                      $uid, 
                      "lrswipcda" 
                    );
    $err .= deletemailbox( "user." . param( 'ldapuid' ));
    if( $err ) {
        printerr( "deleteuser: imapdelerr $err" );
        if( $err =~ m/Mailbox does not exist/ ) {
            print "<BR>LDAP entry only will be deleted<BR>";
        } else {
            return;
        }
    } else {
        print "IMAP account for " . param( 'ldapuid' ) . " deleted.<BR>";
    }
    closeimap();

    $ldap = ldapbind();
    return if( $ldap < 0 );

    $err = "";
    my $dn = param( 'dn' );
    my $mesg = $ldap->delete( ldapclean( $dn ));
    $err .= $mesg->error if ( $mesg->code );

    # get a list of all groups this person was a member of
    my @groups;
    $mesg = $ldap->search( base=>$LDAP_BASEDN,
                              filter=>"( $ldapmemberatt=" .ldapclean($dn). ")",
                              attrs=>[ 'dn' ]
                            );
    $err .= $mesg->error if( $mesg->code );
    
    if( $err ) {
        printerr( "Deleting LDAP entry: $err" );
        return;
    }
    $err = "";
    
    my @results = $mesg->entries;
    foreach $result ( @results ) {
        push( @groups, $result->dn() );
    }

    my $whattodelete = { $ldapmemberatt, $dn };
  
    # And delete the user from each group he/she was listed in
    for( @groups ) {
        my $mesg = $ldap->modify( $_, delete=>$whattodelete );
        $err .= $mesg->error if( $mesg->code );
    }

    if( $err ) {
        printerr( "Deleting LDAP entries: $err" );
    } else {
        print "User ", param( 'cn' ), " deleted successfully.<BR>";
    }

    $ldap->unbind;
    param( 'op', 'ldapsearch' );
    param( 'dn', '' );
    ldapsearch();
    return;
}


# Parses form data from the confirmdelete HTML form and deletes that group's
# entry from the directory

sub deletegroup {
    checkbuttons();

    if( !$userisadmin ) {
        autherr();
        return;
    }

    $ldap = ldapbind();
    return if( $ldap < 0 );

    my $err = "";
    my $dn = param( 'dn' );
    my $mesg = $ldap->delete( ldapclean( $dn ));
    $err = $mesg->error if ( $mesg->code );

    if( $err ) {
        printerr( "Deleting LDAP entries: $err" );
    } else {
        print "Group ", param( 'cn' ), " deleted successfully.<BR>";
    }

    $ldap->unbind;
    param( 'op', 'ldapsearch' );
    param( 'dn', '' );
    ldapsearch();
    return;
}


# Prints a form asking the user to confirm the deletion of a user or group
# when the op attribute is set to confirmdelete. Possible op attribute values 
# generated from this form are deleteuser, deletegroup

sub confirmdelete {
    my $dn = param( 'dn' );
    my $cn = param( 'cn' );
    my $entrytype = param( 'entrytype' );

    if( !$userisadmin ) {
        autherr();
        return;
    }

    if(( $entrytype ne "user" )&&( $entrytype ne "group" )) {
        printerr( "Unknown entry type - can't delete entry $cn." );
        return;
    }
    $op = "delete" . $entrytype;
    param( 'op', $op );
    print hidden( 'dn' );
    print hidden( 'cn' );
    print hidden( 'ldapuid' );
    
    print "<CENTER><BR><H4> Confirm: Really delete $entrytype $cn? </H4><BR>";
    print "<BR> If so, press the Save Changes button.\n";
    print "<BR> If not, press the back button in your browser.\n</CENTER>";
    return;
}


# Prints an HTML form that lets an admin edit user data or create new users.
# If the user running this script doesn't have admin privs, it prints the data
# in a read-only format instead of as an editable form.
# Possible op attributes generated from this form are createuser and changeuser

sub printuser {
    my ( $getgroupinfo ) = @_;
    checkbuttons();
    ldapsearch();

    param( 'entrytype', 'user' );
    my $ldap = ldapbind();
    my $op = param( 'op' );
    my $ldapdata;
    my $passvalue;
    my $entrytype = 'user';
    my $dn = param( 'dn' );

    if ( $dn ) {
        # get user info from LDAP and ( if $userisadmin ) IMAP servers

        $ldapdata = ldapget( $ldap, $dn );

        # First we want to clear out all the HTML parameters in case $ldapdata
        # returns null values and fails to overwrite existing param values
        param( 'cn', '' );
        param( 'ldapuid', '' );
        param( 'mail', '' );
        param( 'sn', '' );
        param( 'givenname', '' );
        param( 'maxquota', '' );

        if( $userisadmin ) {
            $op = "changeuser";
            $imap = openimap($uid, $pass, $imapserver, $imapport, $useimapSSL);
            my @imapquota = 
                getquota( "user." . scalar( $ldapdata->get_value( 'uid' )));
            param( 'usedquota',  $imapquota[1] );
            param( 'maxquota',  $imapquota[2] );
            closeimap();
        }

        param( 'cn',        scalar( $ldapdata->get_value( 'cn' )));
        param( 'ldapuid',   scalar( $ldapdata->get_value( 'uid' )));
        param( 'mail',      scalar( $ldapdata->get_value( 'mail' )));
        param( 'sn',        scalar( $ldapdata->get_value( 'sn' )));
        param( 'givenname', scalar( $ldapdata->get_value( 'givenname' )));

        # loop through the rest of the attributes
        for( $i = 0; $i < $#ldappersonatts; $i += 2 ) { 
            param( $ldappersonatts[ $i ], '' );
            param( $ldappersonatts[ $i ], 
                   scalar( $ldapdata->get_value( $ldappersonatts[ $i ] )));
        }
    } else {
        $op = "createuser" if( $userisadmin );
    }
    
    # print the HTML - different for users than admins
    print "<TABLE WIDTH=90%><TR><TD>";
    if( param( 'photo' )) {
        print "<IMG ALIGN=RIGHT SRC=", param( 'photo' ), " TITLE=\"Photo of ",
              param( 'cn' ), "\" >";
    }
    print "<CENTER>";
    if( $userisadmin ) {
        # print the screen that lets one make changes to user information 
        print "<TABLE WIDTH=60%><TR><TD>Employee UID:</TD><TD>";

        if( $op eq "changeuser" ) {  #user is admin and op is changeuser

            print param( 'ldapuid' ), "</TD></TR>\n<TR><TD>E-mail Address:<BR>";
            print "</TD><TD>", param( 'ldapuid' ), "\@", $maildomain, "<BR>";
            print "</TD></TR>\n<TR><TD>Name:</TD><TD>",
                  param( 'givenname' ), " ", param( 'sn' );

            print hidden( 'entrytype' );
            print hidden( 'ldapuid' );
            print hidden( 'dn' );
            print hidden( 'mail' );
            print hidden( 'cn' );

            # Note that we don't allow the admin to change the user's uid.
            # With a Cyrus server using LDAP that would be a complex,
            # configuration-dependant process that would involve changing the
            # the RDN on the LDAP server, and on the Cyrus server we would have
            # to create a new user, then copy all the mailboxes from the user's
            # old account to their new one, and delete the old ones. With all
            # the possible different system configurations that seems risky
            # and very difficult to implement robustly. We'll just force
            # the admin to create a new user account and have the user copy
            # their messages from the old account to the new one.

        } else {      # user is admin and op is createuser
            # if not "changeuser" then $op must equal "createuser", so we will
            # need to allow the admin to enter the new user's uid and passwd

            print textfield( -name=>'ldapuid',
                             -maxlength=>40,
                             -size=>40
                           );
            print "</TD></TR>\n<TR><TD>First Name:</TD><TD>",
                  textfield(-name=>'givenname', 
                            -value=>param( 'givenname' ) || "",
                            -maxlength=>75,
                            -size=>40
                           );
            print "</TD></TR>\n<TR><TD>Last Name:</TD><TD>",
                  textfield(-name=>'sn',
                            -value=>param( 'sn' ) || "",
                            -maxlength=>75,
                            -size=>40
                           );

            if( $suggestpass ) {
                # suggest a random password when creating new users
                $passvalue = scalar( `$suggestpass` );
                chomp( $passvalue );
            }
        }        # below here printed for any op value if user is admin
        if( $passvalue ) {  # if configured to suggest a default password
            # Note that if $suggestpasswd is undefined in the ldapextras.conf
            # file, $passvalue will always be undefined, too
            print "</TD></TR><TR><TD COLSPAN=2>A random alphabetic",
                  " password has been entered for your convenience.";
            print "</TD></TR><TR><TD>Password:</TD><TD>",
                   textfield( -name=>pass1,
                              -value=>$passvalue || "",
                              -override=>1,
                              -size=>40,
                              -maxlength=>15
                            );
            print "</TD></TR><TR><TD>Password (again):</TD><TD>",
                   textfield( -name=>pass2,
                              -value=>$passvalue || "",
                              -override=>1,
                              -size=>40,
                              -maxlength=>15
                            );
        } else {         #print blank password fields
            print "</TD></TR><TR><TD>Password:</TD><TD>",
                   password_field( -name=>pass1,
                                   -value=>"",
                                   -override=>1,
                                   -size=>40,
                                   -maxlength=>15
                                 );
            print "</TD></TR><TR><TD>Password (again):</TD><TD>",
                   password_field( -name=>pass2,
                                   -value=>"",
                                   -override=>1,
                                   -size=>40,
                                   -maxlength=>15
                                 );
        }
        # still in the userisadmin block
        #Loop through the rest of the attributes
        for( $i = 0; $i < $#ldappersonatts; $i += 2 ) { 
            print "</TD></TR>\n<TR><TD>", 
                  $ldappersonatts[ $i + 1 ], ":</TD><TD>";
            if( $ldappersonatts[ $i ] !~ /street/i ) {

                # for any attributes except the street address:
                print textfield(-name=>$ldappersonatts[ $i ],
                                -value=>param( $ldappersonatts[ $i ])||(""),
                                -maxlength=>75,
                                -size=>40
                               );
            } else {  

                # print a textarea instead of textbox for street addresses
                print textarea(-name=>$ldappersonatts[ $i ],
                               -value=>param( $ldappersonatts[ $i ] )||(""),
                               -rows=>4,
                               -columns=>38
                              );
            
            }
        }
        
        if( $op eq 'changeuser' ) {
            print "</TD></TR>\n<TR><TD>Disk Quota Limit (KB):</TD><TD>",
                  textfield(-name=>'maxquota',
                            -maxlength=>20,
                            -size=>40
                           ),
                  "</TD></TR>\n<TR><TD>Disk Quota Used (KB):</TD><TD>", 
                  param('usedquota'), "</TD></TR>\n<TR><TD COLSPAN=2>";
            print "<HR><CENTER>", submit( 'Save Changes' ),
                   submit( 'Get Group Info' ), submit( 'Delete This User' ), 
                   "</CENTER>";
        }
        print "</TD></TR></TABLE>\n";

    } else {    # if user is not the admin
        # print the screen ordinary mortals will see
        print hidden( 'dn' );
        print hidden( 'mail' );
        print hidden( 'cn' );
        print hidden( 'sn' );
        print hidden( 'givenname' );

        print "<TABLE WIDTH=60%><TR><TD>Employee:</TD><TD>", param( 'cn' ), 
            "</TD></TR>\n";
        print "<TR><TD>E-mail Address:</TD><TD>", param( 'mail' ), 
            "</TD></TR>\n";

        # loop through the rest of the attributes
        for( $i = 0; $i < $#ldappersonatts; $i += 2 ) { 
            next if exists $donotdisplay{ $ldappersonatts[ $i ] };
            print hidden( $ldappersonatts[ $i ] );
            if( param( $ldappersonatts[ $i ] )) {
                print "<TR><TD>", $ldappersonatts[ $i + 1 ], "</TD><TD>",
                      param( $ldappersonatts[ $i ] ), "</TD></TR>";
            }
        }
        print "<TR><TD COLSPAN=2><BR></TD></TR><TR><TD>",
              "Click here to see which e-mail groups<BR>",
              "will forward mail to this person. </TD><TD>";
        print submit( 'Get Group Info' );
        print "</TD></TR><TR><TD COLSPAN=2><BR></TD></TR></TABLE>\n";
    }     # Below here will apply whether or not $userisadmin


    getallgroups( $ldap, $dn, param( 'cn' )) if( $getgroupinfo ); 
    print "</TD></TR></TABLE>\n";
    $ldap->unbind;
    undef $ldap;
    param( 'op', $op );
    return;
}


# Prints an HTML form that lets an admin edit the members of a group.
# If the user running this script doesn't have admin privs, it prints the data
# read-only instead of as an HTML form, and members of the group are listed
# as links to display info about that member.
# Possible op attributes from this form are creategroup and changegroup 

sub printgroup {
    my $buttonpush = checkbuttons();
    return if( $buttonpush );

    # print the ldapsearch textbox
    ldapsearch();

    my $dn = param( 'dn' );
    my $ldap = ldapbind();

    if ( $dn ) {
        # get group info from LDAP server

        my $ldapdata = ldapget( $ldap, $dn );
        # clear out old param values in case $get_value returns null and fails
        # to overwrite the HTML parameter will a null value
        param( 'cn', '' );
        param( 'members', '' );

        param( 'cn', scalar( $ldapdata->get_value( 'cn' )));

        my @members;
        my $entrytype;
        my $filter = "(|";
        my @memberarray = $ldapdata->get_value( $ldapmemberatt );

        # for performance reasons we don't want to perform a seperate search
        # for every DN in the group, so we'll build a search filter that will
        # only capture these DNs.
        for( @memberarray ) {
            $_ =~ m/([^,]*),.*/;
            my $cn = ldapclean( $1 );
            $filter .= "($cn)";
        }
        $filter .= ")";

        $mesg = $ldap->search( base=>$LDAP_BASEDN,
                               filter=>$filter,
                               attrs=>[ "uid", "cn", "objectClass" ]
                             );
        printerr( "printgroup:" . $mesg->error ) if( $mesg->code );

        my @entries = $mesg->entries;
        my $count = 0;
        foreach $memberentry ( @entries ) {
            getentrytype( $memberentry );
            my $displayname;
            my $entrytype = $memberentry->get_value( 'entrytype' );
            my $cn = $memberentry->get_value( 'cn' );
            if( $entrytype eq 'group' ) {
                $displayname = $cn
            } else {
                $displayname = $memberentry->get_value( 'uid' );
            }
            my $dn = $memberentry->dn();
            
            # the data to be stored in the 'members' HTML param  will be a tab-
            # delimited string.
            # @members is an array of anonymous arrays. The first element of
            # these subarrays will be the line as written to the members HTML
            # param. The second and third elements will be the cn and entrytype
            # respectively, lowercased to use in sorting the @members array
            $members[ $count ] = [ $entrytype . "\t" . $displayname . "\t" .
                                          $cn . "\t" . $dn . "\n" ,
                              lc( $cn ),
                              $entrytype 
                             ];
            $count++;
        }

        # Sort @members first by entrytype, then alphabetically
        @members = sort {
            $b->[2] cmp $a->[2]
                    ||
            $a->[1] cmp $b->[1] 
        } @members; 

        # write the sorted results to the members HTML param
        my $output = "";
        for( @members ) {
           $output .= $_->[0];
        } 
        param( "members", $output );

        $op = 'changegroup' if( $userisadmin );
    } else {
        $op = 'creategroup' if( $userisadmin );
    } 

    my @members = split( /\n/, param( 'members' ));

    # print the HTML
    print "<CENTER>";

    if( $userisadmin ) {
        if( $op eq 'changegroup' ) {
            print "<H3>Members of Group ",param('cn'),":</H3><BR>";
            my $displaystring;
            print hidden( 'members' );
            print hidden( 'dn' );
            print hidden( 'cn' );
            for( @members ) {
                my ( $entrytype, $displayname, $cn, $dn ) = split( '\t' );
                $displaystring .= $displayname . "\n";    
            }
            param( 'memberchanges', '' );
            param( 'memberchanges', $displaystring );
            param( 'entrytype', 'group' );
            print hidden( 'entrytype' );
            print "<CENTER>";
            print textarea(-name=>'memberchanges',
                           -rows=>15,
                           -columns=>20
                          );
            print "<BR>", submit( 'Save Changes' ),
                          submit( 'Delete This Group' );
        } elsif( $op eq 'creategroup' ) {
            param( 'cn', '' );
            param( 'members', '' );
            print "Group Name:&nbsp;&nbsp;";
            print textfield( -name=>'cn',
                             -size=>10,
                             -maxlength=>40
                           );
            print "<BR><BR>" , textarea(-name=>'memberchanges',
                                        -rows=>30,
                                        -columns=>20
                                       );

        }
    } else {                     # print the page as everyday users will see it

        print "<H3>Members of Group ",param('cn'),":</H3><BR>";

        param( 'members', '' );
        param( 'mail', '' );
        print "<TABLE WIDTH=80%><TR>";

        my $count = -1;
        my $realop = $op;


        for ( @members ) {
            my ( $entrytype, $displayname, $cn, $dn ) = split( '\t' );

            param( 'op', "print" . $entrytype );
            param( 'dn', $dn );
            print "<TD WIDTH=33%><A HREF=", url( -query_string=>1 ), ">", $cn, 
                  "</A></TD>";
            print "</TR>\n<TR>" if(( ++$count % 3 ) == 2 );
        }    
        print "</TR></TABLE>\n";
        $op = $realop;
    }

    $ldap->unbind;
    undef $ldap;

    param( 'op', $op );
    return;
}


# Accepts a search string in an HTML param, searches the directory for entries
# that match the string, and prints an HTML page with a list of the matching
# entries. Matching entries are printed as HTML links to display info about
# those entries.
# Possible op attributes from this form are printgroup, printuser and ldapsearch

sub ldapsearch {
    # If the user entered a string to search for, search and get the results
    my $searchstring = param( 'searchstring' );
    param( 'searchstring', '' );
    my @results;
    my $realop = param( 'op' );
    if( $searchstring ) {
        # make sure searchstring doesn't contain funny chars such as ';' that
        # might cause unpredictable behavior 
        $searchstring =~ s/[^\w\(\)\-]//;
        ldapclean( $searchstring );
        param( 'Search', '' );
        my $ldap = ldapbind();

        my $mesg = $ldap->search( base=>$LDAP_BASEDN,
                                  filter=>"(cn=\*$searchstring\*)",
                                  attrs=>[ "cn", "objectclass", "uid" ]
                                );
        printerr("ldapsearch error:" . $mesg->error) if( $mesg->code );
        @results = $mesg->entries(["cn"]);

        # Figure out whether each entry is a user or group 
        # and put that data into the entry perl object as attribute 'entrytype'
        # note that this data is not written to the LDAP server
        foreach $result ( @results ) {
            getentrytype( $result );
        }

        @results = sortldapentries( @results );

        $ldap->unbind;
        undef $ldap;

    }

    # print the HTML
    print "<CENTER><TABLE border=1 WIDTH=90%><TR $cb><TD $tb><CENTER>",
          "Search the Directory for:</TD></CENTER><TD $tb><CENTER>";
    print textfield( -name=>'searchstring',
                     -default=>$searchstring,
                     -size=>40,
                     -maxlength=>40
                   );
    print "</CENTER></TD><TD $tb><CENTER>", submit( 'Search' );
    print "</CENTER></TD></TR></TABLE>";
    if( $searchstring && @results ) {
        print "<BR><CENTER>You can get more information about any entry ",
              "listed below by clicking on it.<HR>";
    }
    print "<TABLE WIDTH=100% ALIGN=RIGHT><TR>";
    # print a table of all the LDAP entries that matched the searchstring
    my $count = -1;

    # prevent putting too much data in link query_string
    param( 'members', '' );
    param( 'mail', '' );

    foreach $result ( @results ) {
        my $dn = $result->dn;
        my ( $cn ) = $result->get_value( 'cn' );
        my ( $ldapuid ) = $result->get_value( 'uid' );
        $op = "print" . $result->get_value( 'entrytype' );

        # clear out previous values of params in case one of the get_value
        # calls returned null
        param( 'op', '' );
        param( 'dn', '' );
        param( 'cn', '' );
        param( 'ldapuid', '' );
        param( 'op', $op );
        param( 'dn', $dn );
        param( 'cn', $cn );
        param( 'ldapuid', $ldapuid );
        print "<TD WIDTH=33%><A HREF=", url( -query_string=>1 ), ">", $cn, 
              "</A></TD>";
        print "</TR>\n<TR>" if(( ++$count % 3 ) == 2 );
    }    
    if( !@results && $realop eq "ldapsearch" ) {
        print "<TD><CENTER><BR>",
              "Hint: Enter someone's first or last name, or the first few ",
              "letters of<BR>their e-mail address, or part of the name of an ",
              "e-mail group.</TD></CENTER>";
    }
    print "</TR></TABLE><BR><HR>\n";
    $op = $realop;
    param( 'op', $op );
    return;
}


# Accepts the entry's DN, a printable name, and a reference to a Net::LDAP object
# that has already been been successfully binded to (bound?). Uses the
# grouprecurse function to search the LDAP group structure to determine all
# groups that refer to that uid or cn, either directly or indirectly through
# references from groups that are members of other groups. 

sub getallgroups {
    my( $ldap, $dn, $name ) = @_;
    my @indirectgroups;
    my @directgroups;

    # first, we'll search for groups that the DN is directly a member of
    # so we can differentiate those from indirect ones when printing the HTML
    my $mesg = $ldap->search( base=>$LDAP_BASEDN,
                              filter=>"( $ldapmemberatt=" .ldapclean($dn). ")",
                              attrs=>[ 'dn' ]
                            );
    my $err .= $mesg->error if( $mesg->code );
    my @results = $mesg->entries;
    foreach $result ( @results ) {
        push( @directgroups, $result->dn() );
    }

    # then, we'll use the grouprecurse sub to get a list of all other groups
    # that contain groups that the DN is a member of to make sure we get 'em all
    for( @directgroups ) {
        my $arrayref = \@indirectgroups;
        my $count = 0;
        $err .= grouprecurse( $ldap, $arrayref, $_, $count );
        return $err if( $err );
    }

    # and print the HTML
    print "<TABLE WIDTH=60%><TR><TD>$name is a member of the following groups:",
          "</TD></TR><TR><TD><CENTER>\n";

    # prevent putting extra data in link querystring
    param( 'mail', '' );
    param( 'members', '' );

    for( @directgroups ) {
        my ( $cn ) = ldapgetatt( $ldap, $_, "cn" );
        param( 'op', "printgroup" );
        param( 'dn', $_ );
        print "<A HREF=", url(-query=>1), ">", $cn, "</A><BR>\n";
    }
    print "<BR></TD></TR><TR><TD>This user will also receive mail ",
          "sent to these groups:</TD></TR><TR><TD><CENTER>\n";
    for( @indirectgroups ) {
        my ( $cn ) = ldapgetatt( $ldap, $_, "cn" );
        param( 'op', "printgroup" );
        param( 'dn', $_ );
        print "<A HREF=", url(-query=>1), ">", $cn, "</A><BR>\n";
    }
    print "</TD></TR></TABLE>";
    return;
}

# recursive function called by getallgroups above. Accepts a reference to a
# Net::LDAP object that has already been binded successfully, a reference to the
# array that will be storing all the results, the name of the cn to search
# the groups in the directory for, and a counter variable to detect circular
# references.

sub grouprecurse {
    my( $ldap, $array, $dn, $count ) = @_;
    $count++;
    return "Error! Circular references in groups?\n" if( $count > 20 );
    my $mesg = $ldap->search( base=>$LDAP_BASEDN,
                              filter=>"( $ldapmemberatt=".ldapclean($dn).")",
                              attrs=>[ "dn" ]
                            );
    my $err .= $mesg->error if( $mesg->code );
    my @results = $mesg->entries;
    foreach $result ( @results ) {
        push( @$array, $result->dn );
        $err .= grouprecurse( $ldap, $array, $result->dn, $count );
    }
    return $err;
}


# Quick shortcut for typing $ldap->search(blah blah blah) if you only want
# the contents of one attribute from one dn. Returns an array containing
# the value(s) of that attribute for the dn in question.
sub ldapgetatt {
    my @results;
    my( $ldap, $dn, $attribute ) = @_;
    my $user = ldapget( $ldap, $dn );
    @results = $user->get_value( $attribute );
    return @results;
}

# Gets an entry from the LDAP server given the dn and a bound Net::LDAP object
sub ldapget {
    my( $ldap, $dn ) = @_;
    my $mesg = $ldap->search( base=>$dn,
                              filter=>"(objectclass=*)",
                            );
    if( $mesg->code ) {
        printerr( "ldapget: $dn <BR>" . $mesg->error );
    }
    my @entries = $mesg->entries;
    return $entries[0];
}


# Accepts a string containing error text and prints an error screen

sub printerr {
    my( $err ) = @_;
    print "<H3> Error: </H3><B> $err </B>";
    return;
}

# what to do in the even of an authentication err

sub autherr {
    printerr( "<BR>Think you're sneaky, huh? :)<BR>\nYou don't have access." );
    return;
}


# We need to escape certain characters to prevent Net::LDAP from interpreting
# some characters in DN's from screwing up LDAP searches when the DN is part
# of the searchfilter - this adds backslashes in front of parenthesis, asterisks
# or backslasheatts that appear as literal characters in the DN. 

sub ldapclean {
    my ( $dn ) = @_;
    $dn =~ s/([\(\)\\\*])/\\$1/g;
    return $dn;
}

# for a given Net::LDAP::Entry object, determine whether it's a user or group
# and add an attribute to that object called entrytype 
sub getentrytype {
    my ( $ldapentry ) = @_;
    my @objectclasses = $ldapentry->get_value( "objectClass" );
    for( @objectclasses ) {
        if( /person/i ) {
            $ldapentry->add('entrytype'=>'user');
            last;
        } elsif( /group/i ) {
            $ldapentry->add('entrytype'=>'group');
            last;
        }
    } 
}

# for a given array of Net::LDAP::Entry objects, sort the objects by
# entrytype (see getentrytype function above) and then alphabetically by cn
sub sortldapentries {
    my @results = @_;
    # sort the entries alphabetically and by entrytype
    @results = sort {
        lc( $b->get_value( 'entrytype' )) cmp lc( $a->get_value( 'entrytype' ))
        ||
        lc( $a->get_value( 'cn' ))        cmp lc( $b->get_value( 'cn' ))
    } @results;
        
    return @results;
}

# Bind to the LDAP directory as the current user, return the $ldap object
sub ldapbind {
    # first, bind anonymously to get the DN of the current user 
    my $ldap = Net::LDAP->new( $LDAP_SERVER ) || do {
        printerr( "ldapbind: Couldn't connect to LDAP server: $@" );
        return -1;
    };
    my $mesg = $ldap->bind;
    if ( $mesg->code ) {
        printerr( "ldapbind: couldn't bind anonymously: $@" );
        return -1;
    }

    $mesg = $ldap->search( base=>$LDAP_BASEDN,
                           filter=>"(uid=$uid)"
                         );

    my @entries = $mesg->entries;
    my $user = $entries[0]; 
    my $dn = $user->dn;
    $ldap->unbind;
    undef $ldap;
    $ldap = Net::LDAP->new( $LDAP_SERVER ) || do {
        printerr( "ldapbind: Couldn't connect to LDAP server: $@" );
        return -1;
    };
    $mesg = $ldap->bind( dn=>$dn, password=>$pass );
    if ( $mesg->code ) {
        printerr( "ldapbind: couldn't bind with dn $dn: $@" );
        return -1;
    }
    return $ldap;
}

# check for button pushes and run the appropriate function if
# they have been pushed
sub checkbuttons {

    if( param( 'Search' )) {
        param( 'Search', '' );
        param( 'op', 'ldapsearch' );
        ldapsearch();
        print hidden( 'op' );
        print end_form;
        print end_html;
        exit;
    }

    if( param( 'Delete This Group' )) {
        param( 'Delete This Group', '' );
        param( 'op', 'confirmdelete' );
        confirmdelete();
        print hidden( 'op' );
        print end_form;
        print end_html;
        exit;
    }

    if( param( 'Delete This User' )) {
        param( 'Delete This User', '' );
        param( 'op', 'confirmdelete' );
        confirmdelete();
        print hidden( 'op' );
        print end_form;
        print end_html;
        exit;
    }

    if( param( 'Get Group Info' )) {
        param( 'Get Group Info', "");
        printuser( "getgroupinfo" );
        print hidden( 'op' );
        print end_form;
        print end_html;
        exit;
    }
    return;
}

1; # make require happy