#!/usr/bin/perl
#
# Script to change the subnet used by Debian Edu.  It will eventually
# update LDAP and files on disk.  At the moment it only update part of LDAP.
#
# http://quark.humbug.org.au/publications/ldap/ldap_tut.html
# http://wiki.debian.org/DebianEdu/HowTo/ChangeIpSubnet

use strict;
use warnings;

use Socket;
use Net::LDAP;
use Net::Netmask;
use Getopt::Std;
use Debian::Edu qw(find_ldap_server find_ldap_base prompt4password);

use Data::Dumper;

sub usage {
    my $retval = shift;
    print <<EOF;
Usage: subnet-change [-d] <-n subnet>
Change subnet in LDAP and on disk, for use on the main-server

 -d             Enable debug output.
 -n subnet      Subnet to change to with 10.11.12.13/24 notation.
 -s ldapserver  Which LDAP server to connect to.
 -b ldapbase    LDAP base to operate on.
EOF
    exit $retval;
}
my %opts;
getopts("b:dn:s:", \%opts) || usage(1);

if (!$opts{n}) {
    usage(1);
}

my $oldsubnet = new Net::Netmask('10.0.2.0/23');
my $newsubnet = new Net::Netmask($opts{n});

my $ldapserver = $opts{s} || find_ldap_server() || "ldap";
my $ldapbase   = $opts{b} || find_ldap_base($ldapserver)
    || "dc=skole,dc=skolelinux,dc=no";

my $ldapref = Net::LDAP->new($ldapserver)
    or die "Can not connect to ldap server $ldapserver: $!\n";

$ldapref->bind() or die "Can not bind to ldap server\n";
my $manager = find_user_dn($ldapref, "admin");

print "Modifying as user $manager\n";
my $password = prompt4password('Enter LDAP password (enter for dry-run): ', -echo => '*');

if ($password) {
    print "Using password authentication with $manager\n";
    $ldapref->start_tls();
    $ldapref->bind(
        dn => $manager,
        password => $password
        ) || print "error: failed to bind\n";
} else { # Dry-run
    $ldapref->bind();
}

change_subnets($ldapref, $oldsubnet, $newsubnet);
change_dns($ldapref, $oldsubnet, $newsubnet);
change_dhcp($ldapref, $oldsubnet, $newsubnet);

if (!$ldapref->unbind) {
    print "error: unbinding from LDAP server\n";
}

# FIXME need to edit a lot of files too
replace_hosts_ip("/etc/hosts", $oldsubnet, $newsubnet);

my @files = qw(/etc/network/interfaces /etc/hosts.allow /etc/exports);

for my $file (@files) {
    print "info: You also need to edit $file\n";
}

print <<EOF;
info: Also remember to run this as root after the new IP address is
info: activated

  rm /etc/powerdns/pdns.d/pdns-debian-edu-if.conf
  /usr/share/debian-edu-config/tools/run-at-first-boot

EOF

exit 0;

sub replace_hosts_ip {
    my ($file, $oldnet, $newnet) = @_;
    if (open(my $in, "<", $file) && open(my $out, ">", "$file.new")) {
        my $changed = 0;
        while (<$in>) {
            my ($addr, $rest) =  m/^(\d+\.\d+\.\d+\.\d+)(\s.*)$/;
            if ($addr) {
                my $newaddr = replace_matching_addr($oldnet, $newnet, $addr);
                print $out "$newaddr$rest\n";
                $changed = 1;
            } else {
                print $out $_;
            }
        }
        close($out);
        close($in);
        if ($changed) {
            print "info: changed $file\n";
            rename "$file.new", $file;
        } else {
            unlink "$file.new";
        }
    } else {
        print "error: Unable to read from file $file\n";
    }

}

sub find_user_dn {
    my ($ldapref, $username) = @_;
    my $ldapfilter = "(|(cn=$username)(uid=$username))";
    my($mesg) = $ldapref->search( base => $ldapbase, filter => $ldapfilter);

    $mesg->code && die $mesg->error;

    foreach my $entry ($mesg->all_entries) {
        return $entry->dn;
    }
#    my $entry  = $mesg->pop_entry();
}

sub change_ldap_objects {
    my ($ldapref, $ldapfilter, $filterfunc, $dataref) = @_;
    my($mesg) = $ldapref->search( base => $ldapbase, filter => $ldapfilter);

    print "Searching, filter=$ldapfilter\n";

    $mesg->code && die $mesg->error;

    foreach my $entry ($mesg->all_entries) {
        my $dn = $entry->dn;

        if ($filterfunc) {
            if (0 == $filterfunc->($entry, $dataref)) {
                print "Want to update LDAP object\n  $dn\n";
                if ($password) {

                    if ($entry->{olddn}){
                        my $olddn = $entry->{olddn};
                        my $newdn = $entry->dn();
                        print "Moving to $newdn\n";
                        my ($rdn, $parent) = split(/,/, $newdn, 2);
                        my $msg = $ldapref->moddn( $olddn,
                                                   newrdn => $rdn,
                                                   newsuperior => $parent,
                                                   deleteoldrdn => '1'
                            );
                        print "M: ".$msg->error."\n";
                        $entry->dump;
                    }
                    my $msg = $entry->update($ldapref);
                    print "R: ".$msg->error."\n";
                    if (0 != $mesg->code) {
                        die $mesg->error;
                    }
                } else {
                    $entry->dump;
                }
            }
        }
    }
}

sub change_subnet {
    my ($entry, $dataref) = (@_);
    $entry->dump;
    $entry->replace('ipNetworkNumber', $dataref->{'new'}->base());
    $entry->replace('ipNetmaskNumber', $dataref->{'new'}->mask());
    $entry->dump;
    return 0;
}

sub change_subnets {
    my ($ldapref, $oldsubnet, $newsubnet) = @_;
    my $oldbase = $oldsubnet->base();
    my $oldmask = $oldsubnet->mask();

    my %data = ('old' => $oldsubnet, 'new' => $newsubnet);
    my $filter = "(&(ipNetworkNumber=$oldbase)(ipNetmaskNumber=$oldmask))";
    change_ldap_objects($ldapref, $filter, \&change_subnet, \%data);
}

# Convert a IPv4 address to a number representing the address
sub addr_to_num {
    my $addrstr = shift;
    my @f = split('\.', $addrstr);
    return ($f[0] << 24) + ($f[1] << 16) + ($f[2] << 8) + $f[3];
}

sub num_to_addr {
    my $num = shift;
    my $a = ($num >>  0) & 255;
    my $b = ($num >>  8) & 255;
    my $c = ($num >> 16) & 255;
    my $d = ($num >> 24) & 255;

    return "$d.$c.$b.$a";
}

# Calculate new address for adresses on the old subnet.
sub replace_matching_addr {
    my ($oldnet, $newnet, $addr) = @_;
    return $addr unless $addr;
    my $pos = $oldnet->match($addr);
    return $addr unless $pos;
    $pos += 0;
    return $newnet->broadcast() if ($oldnet->broadcast() eq $addr);
    my $newbase = addr_to_num($newnet->base());;
    my $newaddr = num_to_addr($newbase + $pos);

    return $newaddr;
}

sub replace_matching_arpa {
    my ($oldnet, $newnet, $arpa) = @_;
    my $addr = arpa_to_addr($arpa);
    my $newaddr = replace_matching_addr($oldnet, $newnet, $addr);
    return $arpa unless (defined $newaddr && $addr ne $newaddr);
    my @f = split('\.', $newaddr);
    return sprintf("%d.%d.%d.%d.in-addr.arpa", $f[3], $f[2], $f[1], $f[0]);
}

sub change_dns_record {
    my ($entry, $dataref) = @_;

    if ($entry->get_value('cNAMERecord')) {
        # No IP addresses in CNAME records
        return 1;
    } elsif ($entry->get_value('sRVRecord')) {
        # No IP addresses in SRV records
        return 1;
    } elsif ($entry->get_value('sOARecord')) {
        # No IP addresses in SOA records
        return 1;
    }

    if (my $arecord = $entry->get_value('aRecord')) {
        my $newarecord =
            replace_matching_addr($dataref->{'old'}, $dataref->{'new'},
                                  $arecord);

        return 1 unless $newarecord ne $arecord;
#        $entry->dump;
        $entry->replace('aRecord', $newarecord);
#        $entry->dump;
        return 0;
    }

    my $assocdomain = $entry->get_value('associatedDomain');
    if ( my $ptr = $entry->get_value('pTRRecord') ) {
        print "FIXME: PTR entry need to fix $assocdomain\n";
        $entry->dump;

        # Need to change associatedDomain (look like '') and move
        # object to different dn (look like
        # 'dc=253,dc=0,dc=168,dc=192,dc=in-addr,dc=arpa,ou=dns,dc=skole,dc=skolelinux,dc=no').

        my $newptr =
            replace_matching_arpa($dataref->{'old'}, $dataref->{'new'},
                                  $ptr);
        return 1 unless $newptr ne $ptr;

        $dataref->{ptrs}->{$entry->dn} = $assocdomain;
        return 0;
    }

    print "FIXME: ARPA entry need to fix $assocdomain\n";
    $entry->dump;

    return 1;
}


# Convert "99.3.0.10.in-addr.arpa" to "10.0.3.99"
# Convert "3.0.10.in-addr.arpa" to "10.0.3.0"
sub arpa_to_addr {
    my $arpa = shift;
    $arpa =~ s/.in-addr.arpa//i;
    my @f = split(/\./, $arpa);
    return undef unless defined $f[3];
    return $f[-1] . "." . $f[-2] . "." . $f[-3] . "." . $f[-4];
}

sub update_ptrs {
    my $dataref = shift;

    my $old = $dataref->{'old'};

    # Need to change associatedDomain (look like
    # '253.0.168.192.in-addr.arpa') and move object to different dn
    # (look like
    # 'dc=253,dc=0,dc=168,dc=192,dc=in-addr,dc=arpa,ou=dns,dc=skole,dc=skolelinux,dc=no').

    for my $ptrdn (sort keys %{$dataref->{ptrs}}) {
        my $ptr = $dataref->{ptrs}->{$ptrdn};

        print "P: $ptrdn\n  $ptr\n";
    }
}

# Find all objects with associateddomain attribute, replace arecord
# and others.
sub change_dns {
    my ($ldapref, $oldsubnet, $newsubnet) = @_;
    my %data = ('old' => $oldsubnet,
                'new' => $newsubnet,
                'ptrs' => {});
    change_ldap_objects($ldapref, '(associateddomain=*)',
                        \&change_dns_record, \%data);

    update_ptrs(\%data);
}

sub change_dhcp_record {
    my ($entry, $dataref) = @_;
    my $retval = 1;
    $entry->dump;
    # change cn, dhcpNetMask, dhcpRange with next-server

    for my $attribute (qw(cn dhcpRange dhcpStatements dhcpOption dn)) {
        my @newvalue;
        my $change_netmask = 0;
        my @values;
        if ("dn" eq $attribute) {
            push(@values, $entry->dn());
        } else {
            @values = $entry->get_value($attribute);
        }
        for my $string (@values) {
            my $newstring;
            for my $value (split(/ /, $string)) {
                if ($value =~ m/^\d+\.\d+\.\d+\.\d+$/) {
                    my $newvalue =
                        replace_matching_addr($dataref->{'old'},
                                              $dataref->{'new'},
                                              $value);
                    $newstring .= " $newvalue";
                } elsif ($value =~ m/cn=(\d+\.\d+\.\d+\.\d+)(,.+$)/) {
                    my $newvalue = "cn=" .
                        replace_matching_addr($dataref->{'old'},
                                              $dataref->{'new'},
                                              $1) .
                                              $2;

                    $newstring .= "$newvalue";
                } else {
                    $newstring .= " $value";
                }
            }
            $newstring =~ s/^ //;
            if ($newstring ne $string) {
                print "replacing '$string' with '$newstring'\n";
                $retval = 0;
                push(@newvalue, $newstring);
                # If an entry with broadcast-address changed, remember
                # to check the subnet mask too.
                if ($newstring =~ m/^broadcast-address /) {
                    $change_netmask = 1;
                }
            } else {
                push(@newvalue, $string);
            }
        }
        if ($change_netmask) {
            my $oldnetmask = $dataref->{'old'}->mask();
            my $newnetmask = $dataref->{'new'}->mask();
            print "replacing '$oldnetmask' with '$newnetmask'\n";
            @newvalue =
                map { $_ =~ s/ $oldnetmask/ $newnetmask/g; $_ } @newvalue;
        }

        if (!$retval) {
            if ("dn" eq $attribute) {
                my $newdn = $newvalue[0];
                $entry->{olddn} = $entry->dn();
                $entry->dn($newdn);
            } else {
                $entry->replace($attribute, [@newvalue]);
            }
        }
    }

    return $retval;
}

# Find all objectclass=dhcpSubnet, replace cn and dhcpRange
sub change_dhcp {
    my ($ldapref, $oldsubnet, $newsubnet) = @_;
    my %data = ('old' => $oldsubnet,
                'new' => $newsubnet);
    change_ldap_objects($ldapref, '(|(objectclass=dhcpSubnet)(objectclass=dhcpOptions))',
                        \&change_dhcp_record, \%data);
}
