debian-edu-config 1.702 / usr / share / debian-edu-config / tools / subnet-change

#!/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 POSIX; # for ceil

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.  It can
only be used once right after first boot, and will change away from
the default 10.0.0.0/8 to the subnet selected as an argument for
subnet-change.  Avoid switching to the thin client subnets
(192.168.0.0/24 and 192.168.1.0/24) as this will confuse the DHCP
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.  The default autodetected.
 -b ldapbase    LDAP base to operate on.  The default is autodetected.
EOF
    exit $retval;
}
my %opts;
getopts("b:dn:s:", \%opts) || usage(1);

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

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

# Debug code
if (0) {
    for my $addr (qw(10.0.0.0 10.0.0.1 10.0.2.2 10.0.16.20 10.0.31.254
                     10.255.255.255 192.168.0.254)) {
        my $newaddr = replace_matching_addr($oldsubnet, $newsubnet, $addr);
        print "N: $addr -> $newaddr\n";
    }
    replace_matching_arpa($oldsubnet, $newsubnet, '@', '10.in-addr.arpa.');
    replace_matching_arpa($oldsubnet, $newsubnet, '1.0.0', '10.in-addr.arpa.');
    replace_matching_arpa($oldsubnet, $newsubnet, '2.2.0', '10.in-addr.arpa.');
    replace_matching_arpa($oldsubnet, $newsubnet, '254', '0.168.192.in-addr.arpa.');

    exit 0;
}

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 "Connecting to LDAP server $ldapserver\n";
print "Modifying as user $manager\n";
print "The LDAP password for $manager\nshould be the initial root password\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);
change_gosa($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);
replace_exports_ip("/etc/exports", $oldsubnet, $newsubnet);
replace_interfaces_ip("/etc/network/interfaces", $oldsubnet, $newsubnet);
replace_ips("/etc/samba/smb-debian-edu.conf", $oldsubnet, $newsubnet);
replace_ips("/etc/squid/squid.conf", $oldsubnet, $newsubnet);

# Not needed on main-server (but on all clients):
# /etc/samba/smb-debian-edu-client.conf

my @files = qw(/etc/hosts.allow /etc/munin/debian-edu-munin-node.conf);

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

# Make sure bind see all zones in LDAP, also when the zones change
my $dnszoneupdate =
    "/usr/share/debian-edu-config/tools/ldap2bind-updatezonelist";
print "info: Now running $dnszoneupdate\n";
system($dnszoneupdate);

my $dnsupdate = "/usr/share/debian-edu-config/tools/gosa-sync-dns-nfs";
print "info: Now running $dnsupdate\n";
system($dnsupdate);

my @rmfiles = qw(/opt/ltsp/i386/etc/ssh/ssh_known_hosts
                 /etc/debian-edu/xdebian-edu-firstboot);

for my $file (@rmfiles) {
    print "info: Removing generated file $file\n";
}

print <<EOF;

info: Now you need to reboot to update the IP setup and generate a few files.

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);
                $changed = 1 if ($addr ne $newaddr);
                print $out "$newaddr$rest\n";
            } 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 or write to $file.new\n";
    }
}

sub replace_exports_ip {
    my ($file, $oldsubnet, $newsubnet) = @_;

    my $oldbase = $oldsubnet->base();
    my $oldmask = $oldsubnet->mask();
    my $newbase = $newsubnet->base();
    my $newmask = $newsubnet->mask();
    if (open(my $in, "<", $file) && open(my $out, ">", "$file.new")) {
        my $changed = 0;
        while (my $line = <$in>) {
            my $newline = $line;
            $newline =~ s%$oldbase/$oldmask%$newbase/$newmask%;
            $changed = 1 if ($line ne $newline);
            print $out "$newline";
        }
        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 or write to $file.new\n";
    }
}
sub replace_interfaces_ip {
    my ($file, $oldsubnet, $newsubnet) = @_;

    my $oldmask = $oldsubnet->mask();
    my $newmask = $newsubnet->mask();

    # FIXME the netmask handling should be more robust for reordered
    # lines.

    if (open(my $in, "<", $file) && open(my $out, ">", "$file.new")) {
        my $changed = 0;
        my $ourif = 0;
        while (my $line = <$in>) {
            $ourif = 0 if $line =~ m/iface/;
            my ($pre, $addr, $post) =
                $line =~ m/^(.+\s)(\d+\.\d+\.\d+\.\d+)(\s.*)$/;
            if ($addr) {
                my $newaddr = replace_matching_addr($oldsubnet, $newsubnet,
                                                    $addr);
                if ($addr ne $newaddr) {
                    $line = "$pre$newaddr$post";
                    $changed = 1;
                    $ourif = 1;
                }
            }
            $line =~ s%$oldmask%$newmask% if ($ourif and $line =~ m/netmask/);
            print $out $line;
        }
        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 or write to $file.new\n";
    }
}

sub replace_ips {
    my ($file, $oldsubnet, $newsubnet) = @_;

    if (open(my $in, "<", $file) && open(my $out, ">", "$file.new")) {
        my $changed = 0;
        while (my $line = <$in>) {
            chomp $line;
            if ($line =~ m/^(.*\s)(\d+\.\d+\.\d+\.\d+)(\s.*|\b)$/) {
                my ($pre, $addr, $post) = ($1, $2, $3);
                my $newaddr =
                    replace_matching_addr($oldsubnet, $newsubnet, $addr);
                if ($addr ne $newaddr) {
                    $line = "$pre$newaddr$post";
                    $changed = 1;
                }
            } elsif ($line =~ m%^(.*\s)(\d+\.\d+\.\d+\.\d+)/(\d+)(\s.*)$%) {
                my ($pre, $addr, $bits, $post) = ($1, $2, $3, $4);
                my $newaddr =
                    replace_matching_addr($oldsubnet, $newsubnet, $addr);
                if ($addr ne $newaddr) {
                    my $newbits = $newsubnet->bits();
                    $line = "$pre$newaddr/$newbits$post";
                    $changed = 1;
                }
            }
            print $out "$line\n";
        }
        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 or write to $file.new\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 ($entry->{olddn}){
                    my $newdn = $entry->dn();
                    print "Moving to $newdn\n";
                }

                if ($password) {

                    if ($entry->{olddn}){
                        my $olddn = $entry->{olddn};
                        my $newdn = $entry->dn();
                        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);

    # Scale down to handle smaller nets

    # Can't use $oldnet->size, it is too large with /8.  The number
    # 8190 assume adresses in the range 10.0.0.1 to 10.0.31.254, and
    # make sure the last end up with .254 on a /24 network.
    my $currentusedsize = 8190;

    # FIXME should find algorithm to handle switching to large subnets better.
    # Something giving 2^24 for /8, around 2^23 for /9, and 8190 for /24.
    # if ($newnet->bits() < 12) {
    #   $currentusedsize = $oldnet->size();
    # }

    my $newnetsize =$newnet->size()-2;
    my $newpos = ceil($pos * $newnetsize / $currentusedsize );
    print "NP: $pos*$newnetsize/$currentusedsize -> $newpos\n" if $opts{d};

    my $newbase = addr_to_num($newnet->base());
    my $newaddr = num_to_addr($newbase + $newpos);

    return $newnet->broadcast()-1 if ($newnet->broadcast() eq $newaddr);
    return $newaddr;
}

# See also http://www.zytrax.com/books/dns/ch3/
sub replace_matching_arpa {
    my ($oldnet, $newnet, $relative, $zone) = @_;

    my $arpaoctets;
    if ($newnet->bits() >= 24) {
        $arpaoctets = 3;
    } elsif ($newnet->bits() >= 16) {
        $arpaoctets = 2;
    } elsif ($newnet->bits() >= 8) {
        $arpaoctets = 1;
    } else {
        die "error: Unable to handle subnets larger than /8\n";
    }

    print "Checking $relative . $zone\n";
    if ($zone =~ m/in-addr.arpa./) {
        my $addr = arpa_to_addr("$relative.$zone");
        print "A: $addr\n";
        my $newaddr =
            replace_matching_addr($oldnet, $newnet, $addr);
        if ($newaddr ne $addr) {
            my @f = split(/\./, $newaddr, $arpaoctets + 1);
            print join(" ", @f),"\n";
            $relative = join(".", reverse split(/\./, pop(@f)));
            $zone = join(".", reverse @f) . ".in-addr.arpa.";
            print "r: $relative z: $zone\n";
        }
    }

    return ($relative, $zone);
}

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')
             || $entry->get_value('pTRRecord') ) {

        my $zonename = $entry->get_value('zoneName');
        my $relative = $entry->get_value('relativeDomainName');
        my $soa = 0;
        if ('@' eq $relative) {
            $soa = 1;
            $relative = '0';
        }

        my ($newrelative, $newzonename) =
            replace_matching_arpa($dataref->{'old'}, $dataref->{'new'},
                                  $relative, $zonename);
        if ($newrelative ne $relative || $newzonename ne $zonename) {
            $entry->replace('zoneName', $newzonename);
            $entry->replace('relativeDomainName', $newrelative) unless $soa;

            if ($newzonename ne $zonename) {
                my $olddn = $entry->dn();
                my $newdn = $entry->dn();
                $entry->{olddn} = $newdn;
                if ($soa) {
                    $newdn =~ s/$zonename/$newzonename/;
                    print "rr: $newdn =~ s/$zonename/$newzonename/;\n"
                } else {
                    $newdn =~ s/$relative/$newrelative/;
                }
                $entry->dn($newdn);
            }

            return 0;
        }
        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;
    }

    $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);
    my $addr = ($f[-1]+0) . "." . ($f[-2]+0) . "." . ($f[-3]+0) . "." . ($f[-4]+0);
    return $addr;
}

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

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

    my $change_dhcpnetmask = 0;
    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 $attribute '$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;
                }
                if (lc('dhcpRange') eq lc($attribute)) {
                    $change_dhcpnetmask = 1;
                }
            } else {
                push(@newvalue, $string);
            }
        }
        if ($change_netmask) {
            my $oldnetmask = $dataref->{'old'}->mask();
            my $newnetmask = $dataref->{'new'}->mask();
            print "replacing $attribute '$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]);
            }
        }
    }
    if ($change_dhcpnetmask) {
        my $newnetmask = $dataref->{'new'}->bits();
        $entry->replace('dhcpNetMask', [$newnetmask]);
    }
    # change cn, dhcpNetMask (dhcpsubnet), dhcpRange with next-server

    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)(objectclass=dhcpSharedNetwork))',
                        \&change_dhcp_record, \%data);
}

sub change_gosa_record {
    my ($entry, $dataref) = @_;
    $entry->dump;

    for my $attribute (qw(ipHostNumber)) {
        my @newvalue;
        my $change_netmask = 0;
        my @values = $entry->get_value($attribute);
        for my $value (@values) {
            my $newvalue =
                replace_matching_addr($dataref->{'old'}, $dataref->{'new'},
                                      $value);

            next unless $newvalue ne $value;
            print "replacing $attribute '$value' with '$newvalue'\n";
            $entry->replace($attribute, $newvalue);
        }
    }

    return 0;
}

sub change_gosa {
    my ($ldapref, $oldsubnet, $newsubnet) = @_;

    my %data = ('old' => $oldsubnet,
                'new' => $newsubnet);
    change_ldap_objects($ldapref, '(|(objectclass=ipHost)(objectclass=goServer))',
                        \&change_gosa_record, \%data);
}