Home | History | Annotate | Line # | Download | only in contrib
3.0b1-lease-convert revision 1.1.1.1
      1  1.1  christos #!/usr/bin/perl
      2  1.1  christos #
      3  1.1  christos # Start Date:   Mon, 26 Mar 2001 14:24:09 +0200
      4  1.1  christos # Time-stamp:   <Monday, 26 March 2001 16:09:44 by brister>
      5  1.1  christos # File:         leaseconvertor.pl
      6  1.1  christos # RCSId:        Id: 3.0b1-lease-convert,v 1.1 2001/04/18 19:17:34 mellon Exp 
      7  1.1  christos #
      8  1.1  christos # Description:  Convert 3.0b1 to 3.0b2/final lease file format
      9  1.1  christos #
     10  1.1  christos 
     11  1.1  christos require 5.004;
     12  1.1  christos 
     13  1.1  christos my $rcsID =<<'EOM';
     14  1.1  christos Id: 3.0b1-lease-convert,v 1.1 2001/04/18 19:17:34 mellon Exp 
     15  1.1  christos EOM
     16  1.1  christos 
     17  1.1  christos use strict;
     18  1.1  christos 
     19  1.1  christos my $revstatement =<<'EOS';
     20  1.1  christos 	  switch (ns-update (delete (1, 12, ddns-rev-name, null))) {
     21  1.1  christos 	    case 0:
     22  1.1  christos 	      unset ddns-rev-name;
     23  1.1  christos 	      break;
     24  1.1  christos 	  }
     25  1.1  christos EOS
     26  1.1  christos 
     27  1.1  christos my $fwdstatement =<<'EOS';
     28  1.1  christos 	  switch (ns-update (delete (1, 1, ddns-fwd-name, leased-address))) {
     29  1.1  christos 	    case 0:
     30  1.1  christos 	      unset ddns-fwd-name;
     31  1.1  christos 	      break;
     32  1.1  christos 	  }
     33  1.1  christos EOS
     34  1.1  christos 
     35  1.1  christos 
     36  1.1  christos if (@ARGV && $ARGV[0] =~ m!^-!) {
     37  1.1  christos     usage();
     38  1.1  christos }
     39  1.1  christos 
     40  1.1  christos 
     41  1.1  christos 
     42  1.1  christos # read stdin and write stdout.
     43  1.1  christos while (<>) {
     44  1.1  christos     if (! /^lease\s/) {
     45  1.1  christos 	print;
     46  1.1  christos     } else {
     47  1.1  christos 	my $lease = $_;
     48  1.1  christos 	while (<>) {
     49  1.1  christos 	    $lease .= $_;
     50  1.1  christos 	    # in a b1 file we should only see a left curly brace on a lease
     51  1.1  christos 	    # lines. Seening it anywhere else means the user is probably
     52  1.1  christos 	    # running a b2 or later file through this.
     53  1.1  christos 	    # Ditto for a 'set' statement.
     54  1.1  christos 	    if (m!\{! || m!^\s*set\s!) {
     55  1.1  christos 		warn "this doesn't look like a 3.0b1 file. Ignoring rest.\n";
     56  1.1  christos 		print $lease;
     57  1.1  christos 		dumpRestAndExit();
     58  1.1  christos 	    }
     59  1.1  christos 
     60  1.1  christos 	    last if m!^\}\s*$!;
     61  1.1  christos 	}
     62  1.1  christos 
     63  1.1  christos 	# $lease contains all the lines for the lease entry.
     64  1.1  christos 	$lease = makeNewLease($lease);
     65  1.1  christos 	print $lease;
     66  1.1  christos     }
     67  1.1  christos }
     68  1.1  christos 
     69  1.1  christos 
     70  1.1  christos 
     71  1.1  christos sub usage {
     72  1.1  christos     my $prog = $0;
     73  1.1  christos     $prog =~ s!.*/!!;
     74  1.1  christos 
     75  1.1  christos     print STDERR <<EOM;
     76  1.1  christos usage: $prog [ file ]
     77  1.1  christos 
     78  1.1  christos Reads from the lease file listed on the command line (or stdin if not filename
     79  1.1  christos given) and writes to stdout.  Converts a 3.0b1-style leases file to a 3.0b2
     80  1.1  christos style (for ad-hoc ddns updates).
     81  1.1  christos EOM
     82  1.1  christos 
     83  1.1  christos     exit (0);
     84  1.1  christos }
     85  1.1  christos 
     86  1.1  christos 
     87  1.1  christos 
     88  1.1  christos # takes a string that's the lines of a lease entry and converts it, if
     89  1.1  christos # necessary to a b2 style lease entry. Returns the new lease in printable form.
     90  1.1  christos sub makeNewLease {
     91  1.1  christos     my ($lease) = @_;
     92  1.1  christos 
     93  1.1  christos     my $convertedfwd;
     94  1.1  christos     my $convertedrev;
     95  1.1  christos     my $newlease = "";
     96  1.1  christos     foreach (split "\n", $lease) {
     97  1.1  christos 	if (m!^(\s+)(ddns-fwd-name|ddns-rev-name)\s+(\"[^\"]+\"\s*;)!) {
     98  1.1  christos 	    $newlease .= $1 . "set " . $2 . " = " . $3 . "\n";
     99  1.1  christos 
    100  1.1  christos 	    # If there's one of them, then it will always be the -fwd-. There
    101  1.1  christos 	    # may not always be a -rev-.
    102  1.1  christos 	    $convertedfwd++;
    103  1.1  christos 	    $convertedrev++ if ($2 eq "ddns-rev-name");
    104  1.1  christos 	} elsif (m!^\s*\}!) {
    105  1.1  christos 	    if ($convertedfwd) {
    106  1.1  christos 		$newlease .= "\ton expiry or release {\n";
    107  1.1  christos 		$newlease .= $revstatement if $convertedrev;
    108  1.1  christos 		$newlease .= $fwdstatement;
    109  1.1  christos 		$newlease .= "\t  on expiry or release;\n\t}\n";
    110  1.1  christos 	    }
    111  1.1  christos 	    $newlease .= "}\n";
    112  1.1  christos 	} else {
    113  1.1  christos 	    $newlease .= $_ . "\n";
    114  1.1  christos 	}
    115  1.1  christos     }
    116  1.1  christos 
    117  1.1  christos     return $newlease;
    118  1.1  christos }
    119  1.1  christos 
    120  1.1  christos 
    121  1.1  christos sub dumpRestAndExit {
    122  1.1  christos     while (<>) {
    123  1.1  christos 	print;
    124  1.1  christos     }
    125  1.1  christos     exit (0);
    126  1.1  christos }
    127