
# maintainer.pl - implements all functions associated with the maintainer
# attribute, as defined in ripe-??
#
# Copyright (c) 1993, 1994, 1995, 1996, 1997, 1998, 1999 by RIPE NCC
#
# All Rights Reserved
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that copyright notice and this permission notice appear in
# supporting documentation, and that the name of the author not be
# used in advertising or publicity pertaining to distribution of the
# software without specific, written prior permission.
#
# THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL
# AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
# DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
# AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#
# $Id: maintainer.pl,v 2.13 1999/10/06 16:41:13 marek Exp $
#
#	$RCSfile: maintainer.pl,v $
#	$Revision: 2.13 $
#	$Author: marek $
#	$Date: 1999/10/06 16:41:13 $

# There is a few global variables it will use for authorisation:
# 
# $FROM - contains From: field from mail header
# $PASSWD - contains password found in message

# Also, the last maintainer object is kept globally for simplicity.
# Otherwise we keep looking the stupid thing up again and again and again.....

# maintainer - this is the main routine. It will receive two objects,
# the new and old object, and starts processing from there.
#
# Here's the scoop:
# 
# OldObject is empty: addition
# NewObject is empty: delete
# None empty:         normal update

require "notify.pl";
require "entype.pl";
require "hiermnt.pl";
require "dpr.pl";

# %CurMaintainer and %ExistMaintainer seem to be local to this file
# and used by various subs within it.


sub Maintainer {
    local(*OldObject, *NewObject, $options, $othermntners) = @_;
    
    local($mntners, $mntner);
    
#    &dpr("othermntners=$othermntners, newmb: ", 
#	 $NewObject{"mb"}, ", oldmb: ", $OldObject{"mb"},"\n");
#    &dpr("override option: ", ($options & $OVERRIDEOPTION), "\n");

    if ($othermntners) {
       $mntners=$othermntners; 
    } 
    else {
       
       if ($options & $NEWOPTION) {
          $mntners=$NewObject{"mb"};
       }
       else {
          $mntners=$OldObject{"mb"};   
       }
       
    }

    #
    # No maintainers mentioned, just return OK.
	
    return 1 if (!$mntners);

    # special case - adding maintainers to the TEST database
    # which are maintained by themselves - skip authorization

    return 1 if ($opt_T)                 
	     && ($options & $NEWOPTION) 
	     && ($NewObject{"mt"}) && ($mntners =~ /$NewObject{"mt"}/);

# see comment about notifying maintainers near the end of this function

#    if (($options & $NEWOPTION) && 
#	($opt_T)               &&
#	($mntners =~ /$NewObject{"mt"}/)) {
#
#	# Notify maintainers
#	if ($othermntners) {
#	    &NotifyMaintainers(*OldObject, *NewObject, $othermntners);
#	}
#	else {
#	    &NotifyMaintainers(*OldObject, *NewObject, "");
#	}	
#	return 1;
#    }


    # check authorization if no override

    if (!($options & $OVERRIDEOPTION)) {
    
       local($status)=0;

       foreach $mntner (split(/\s+/, $mntners)) {

          if ($options & $NEWOPTION) {  
             last if (($status=&VrfyMaint($mntner, *NewObject)));
          }
          else {
             last if (($status=&VrfyMaint($mntner, *OldObject)));   
          }
	
       }
    

       if (!$status) {

          #
          # Auth failed. Bounce to originator and forward to maintainer
          # Same as above.

          if ($othermntners) {
             &ForwardToMaint(*OldObject, *NewObject, $othermntners);
          }
          else {
             &ForwardToMaint(*OldObject, *NewObject, "");
          }

          return 0;
    
       }

    }
    
    #
    # Notify maintainers removed out of this function
    # we don't want to notify maintainers about the success 
    # while hierarchical authorisation is still to come and could fail
    # And this is side effect after all

#    if ($othermntners) {
#       &NotifyMaintainers(*OldObject, *NewObject, $othermntners);
#    }
#    else {
#       &NotifyMaintainers(*OldObject, *NewObject, "");
#    }
	
    return 1;
    
}

# GetMaintainer($maintainername, $source, $lognotexistingmntners)
#
# Get maintainer object from database. As a "side effect" sets
# global variables %ExistMaintainer and %CurMaintainer which are
# also used outside of this function.

sub GetMaintainer {
    local($maintainername, $source, $lognotexistingmntners) = @_;
    local($mntdb)='mntdb';
    local(%mntdb,@mntdb); 
    local(%nothing) = ();
    local($normalized) = $maintainername;
    local($dbfile);
    $normalized =~ tr/A-Z/a-z/;

    local(@keys) = ($normalized);

    return %CurMaintainer if ($CurMaintainer{"mt"} eq $maintainername);

    if ($SPLIT{$source}) {
	$dbfile = "$DBFILE{$source}.mt";
    } else {
	$dbfile = $DBFILE{$source};
    }
    if (&dbopen($mntdb, *nothing, 0, $dbfile)) {
	local(@matches) = &dbmatch(*mntdb, *keys, "",  0);
	if ($#matches > 0) {
	    &syslog("ERRLOG","GetMaintainer - found more than one match for ".
		    "maintainer: $maintainername\n");
	    # Set error, should not happen!!!!!
	    &dbclose(*mntdb);
	    return undef;
	}
	if (!$matches[0]) {
	    &syslog(
		    "ERRLOG",
		    "GetMaintainer() no match found for maintainer $maintainer"
		    ) if ($lognotexistingmntners);
	    &dbclose(*mntdb);
	    return undef;
	}
	&enread($mntdb, *CurMaintainer, $matches[0]);
	$ExistMaintainer{$CurMaintainer{"mt"}} = 1;
	&dbclose(*mntdb);
	return %CurMaintainer;
    }
    else {
	&syslog("ERRLOG",
		"GetMaintainer - failed to open $DBFILE{$source}.mt\n"
		);
	return undef;
    }
}

# This routine gets the maintainer object and looks at the auth fields
# Calls different routines depending on auth method
sub VrfyMaint {
    local($maintainer, *object) = @_;
    local($status);
    local($source) = $object{"so"};

    if (&GetMaintainer($maintainer, $source,1)) {
	foreach (split(/\n/, $CurMaintainer{"at"})) {
	    $status = 0;
	    if ($_ eq "NONE") {
		return 1;
	    }
	    if ($_ =~ /^MAIL-FROM/) {
		$status = &CheckMailFrom($_);
		return 1 if $status;
		next;
	    }
	    if ($_ =~ /^CRYPT-PW/) {
		$status = &CheckPassword($_);
		return 1 if $status;
		next;
	    }
            if ($_ =~ /PGPKEY/) {
                $status = &CheckPGP($_);
                return 1 if $status;
                next;
            }
	}
	return $status;
    }
    else {
	return 0;
    }
    
}
    

sub CheckMailFrom {
    local($line) = @_;

    $line =~ m/MAIL-FROM\s+(\S.*)$/;
    local($regex) = $1;
    $regex =~ s/\\?\@/\Q\@\E/g;   # quote '@'s for perl5
    
#    &dpr("$FROM=~ /$regex/\n");

    # case insensitive match
    return 1 if $FROM =~ /$regex/i;
    &syslog("AUDITLOG", "Auth email failure \"$FROM\" !~ \"$regex\"");
    return 0;

}

sub CheckPassword {
    local($line) = @_;

    $line = m/CRYPT-PW\s+(\S+)/;
    local($cpwd) = $1;

    return 1 if crypt($PASSWORD, $cpwd) eq $cpwd;
    &syslog("AUDITLOG", "Auth passwd failure \"$PASSWORD\" !~ \"$cpwd\"");
    return 0;
}

#
# Check PGP authentication
#

sub CheckPGP {
   my ($line)=@_;
   my $key;

   unless ($line =~ /PGPKEY-([0-9a-fA-F]{8})/) {
     return 0;
   }
   $key = $1;

   print "In CheckPGP. Message KEYID = $Main::KEYID, Mntner KEYID = $key\n" 
       if ($opt_V);

   if (!defined($PGP_signed)) {
     &syslog("AUDITLOG","Auth PGP failed. (No signature?)");
     return 0;
   }
   if ($PGP_signed ne $key) {
     &syslog("AUDITLOG","Auth PGP failed. Wrong KEYID: $PGP_signed vs $key");
     return 0;
   }
   return 1;
}

#
# This routine will handle the mnt-nfy function in the maintainer object
# It will extract the email addresses from mnt-nfy attribute, and from
# there on, treat them as normal notifiers.

sub NotifyMaintainers {
    local(*OldObject, *NewObject, $othermntners) = @_;
    
    local(@notif) = ();
    local($line);
    local($m) = 0;
    local($source);
    
    if ($othermntners) {

       @notif=split(/\s+/, $othermntners);
       
       $source = $OldObject{"so"};
       $source = $NewObject{"so"} if (!$source);

    }
    elsif ($OldObject{"mb"}) {
       foreach $line (split(/\n/, $OldObject{"mb"})) {
          push(@notif, split(/\s+/, $line));
          $source = $OldObject{"so"};
       }
    }
    else {
       foreach $line (split(/\n/, $NewObject{"mb"})) {
          push(@notif, split(/\s+/, $line));
          $source = $NewObject{"so"};
       }
    }
    
    local(@notifications)=();
    local(%notifications)=();
    
    foreach $m (@notif) {
	
       #
       # skip doubles
	
       next if ($notifications{$m});
       $notifications{$m}=1;
	
       &GetMaintainer($m, $source,1);
	   
       push(@notifications, split(/\n/, $CurMaintainer{"mn"})) if ($CurMaintainer{"mn"});

    }

    &DoAddNotify(*notifications, *OldObject, *NewObject);

}

#    
# This routine will forward objects to a all maintainers if authorisation
# failed. The message configured in config should make clear to the 
# maintainer that the update actually failed, and they should take action
# as the proper maintainers.
# Notification of succeeded updates for maintainers is done through
# the normal notify mechanism only if maintainer object contains a
# mnt-nfy attribute.

sub ForwardToMaint {
    local(*OldObject, *NewObject, $othermntners) = @_;
    
    local($line);
    local(@maintainers) = ();
    local($oldtype) = &entype(%OldObject);
    local($newtype) = &entype(%NewObject);
    local($source);
    local($email,$regularemail);
    
#    &dpr("forwarding othermntners=$othermntners\n");
    
    if ($othermntners) {

       @maintainers=split(/\s+/, $othermntners);
       
       $source = $OldObject{"so"};
       $source = $NewObject{"so"} if (!$source);

    }
    elsif ($OldObject{"mb"}) {
	foreach $line (split(/\n/, $OldObject{"mb"})) {
	    push(@maintainers, split(/\s+/, $line));
	    $source = $OldObject{"so"};
	}
    } else {
	foreach $line (split(/\n/, $NewObject{"mb"})) {
	    push(@maintainers, split(/\s+/, $line));
	    $source = $NewObject{"so"};
	}
    }
    
    local(%maintainers)=();
    local(%emails)=();

    foreach (@maintainers) {
	
       #
       # skip double maintainers

       next if ($maintainers{$_});
       $maintainers{$_}=1;

       if (!&GetMaintainer($_, $source,1)) {
          &syslog("ERRLOG", "Failed to get maintainer $_ in fwd msg generation");
	  return;
       }

       foreach $email (split(/\n/, $CurMaintainer{"dt"})) {
       
          #
          # skip double notifies
          
          next if ((!$email) || ($emails{$email}));
          $emails{$email}=1;
          
          #
          # skip people that already getting the ACK message
        
          $regularemail=&MakeRegular($email);
          next if ($REPLYTO=~ /$regularemail/);

	    if (!$forward{$email}) {
		$forward{$email} = &ForwardTmpFile($email);
		open(FORWARD, ">$forward{$email}") ||
		    &syslog("ERRLOG",
			    "Cannot create maintainer fwd file $forward{$email}");
		&WriteForwardHeader(FORWARD, $email);
	    } else {
		open(FORWARD, ">>$forward{$email}") ||
		    &syslog("ERRLOG",
			    "Cannot open maintainer fwd file $forward{$email}");
	    }
	    
	    print FORWARD "---\n";
	    if (!$newtype) {	# Deletion
		print FORWARD "DELETION REQUESTED FOR:\n";
		&enwrite(FORWARD,*OldObject,1,0,1);
	    }
	    elsif (!$oldtype) {	# Addition
		print FORWARD "ADDITION REQUESTED FOR:\n";
		&enwrite(FORWARD,*NewObject,1,0,1);
	    }
	    else {		# Update
		print FORWARD "UPDATE REQUESTED FOR:\n";
		&enwrite(FORWARD,*NewObject,1,0,1);
	    }
	    print FORWARD "\n";
	    
	    close(FORWARD);
	    
	}
    }

}

sub ForwardTmpFile {
    local($email) = @_;
    return "$TMPDIR/$email.$$";
}

sub WriteForwardHeader {
    local($filehandle, $email) = @_;

    if ($TESTMODE) {
	$origemail = $email;
	$email = $DEFMAIL;
        print $filehandle $FWHEADER, "To: ", $email, "\n";
        print $filehandle "X-Forward-Orig-Recipient: ", $origemail, "\n\n";
        print $filehandle $FWTXT;
    }
    else {
        print $filehandle $FWHEADER, "To: ", $email, "\n\n", $FWTXT;
    }

    
    if ($NETWORKUPDATE) {
       print $filehandle $FWNETWORKTXT, "\n";
    }
    else {
       print $filehandle $FWMAILTXT, "\n";
    }
    
}

sub SendForwardMails {

    foreach (values %forward) {
       system("$MAILCMD < $_");
       print STDERR "forward: $_\n" if ($opt_V);
    }
    
    unlink(values %forward);
    
    %forward=();
    
}

1;
