#! /usr/bin/perl -w

## Copyright (C) 1998 Hrvoje Niksic
## Modification by Zeljko Boros (block entries, removing old entries)
## More options and use strict by Zoran Dzelajlija on 2004-02-24
## Quite a few improvements by Damir Dzeko on 2005-03-18 (see bellow)
##
## This program is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2 of the License, or
## (at your option) any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
## GNU General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program; if not, write to the Free Software
## Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

## altered by ddzeko, 2005-03-18
## -> reformated code, introduced coding conventions
## -> increased reliability through atomic actualization
## -> everything is done in the memory - more mem, less i/o
## -> removed append mode - in-place editing considered harmful
## -> added in-place mode as option

use strict;
use Fcntl qw(:DEFAULT :flock :seek);

sub DEBUG () { 0 };

# coding convention: CamelCase vars are global here
#
my ($ProgramName, $UsageLong, $UsageShort, $VERSION);

$VERSION = '2.1';

# Looks nicer without the slashes and dots
($ProgramName = $0) =~ s!.*/!!; # strip dir
$ProgramName =~ s!\.[^.]+$!!;   # strip last ext

# 34567890  34567890  34567890  34567890  34567890  34567890  34567890 345678

$UsageLong = "
 $ProgramName -- versatile line-based file updating tool
                 usually used by package configuration scripts

 Usage: $ProgramName [options] PACKAGE FILE < stdin-content


  - General options:

           -r | --remove            Remove entry PACKAGE from FILE.
                                    Default is to add lines from stdin.

           -x | --change            Modify existing block, or add it if
                                    it does not exist but the begin mark
                                    can be found.

           -m | --allow-multiple    Allow multiple blocks of the same type.
                                    By default, old blocks are replaced with
                                    the new one.

           -h | --help              Print this message (usage reference).

                --version           Print version message.

  - Placement control:

           -t | --insert-on-top     Insert stdin-content block on top.
                                    The default is to add it at the bottom.

           -i | --insert-after   x  Insert after this/matching line.
           -f | --insert-before  x  Insert before this/matching line.

  - Manipulating block marks:

           -c | --comment        x  Use alternative comment char/string.
                                    The default is shell-style \#-sign.

                --comment-end    x  Use this marker for comment ending.
                                    The default is none. Ie. '-->', '*/'.

           -b | --begin-mark     x  Block starting mark (ie. 'service ftp')
           -e | --end-mark       x  Block ending mark (ie. '}')

                  These will delete to the end of the file if no end mark
                  is found. The deletion is otherwise not greedy and stops
                  at the first end mark found. You can use \%P to insert
                  the PACKAGE argument, and \%\% to insert a literal \% sign
                  into the mark.

   - File handling options:

           -p | --in-place          Try to preserve original inode.
           -n | --no-close          Do not close and reopen file when
                                    editing it in place.

   Options marked with 'x' take single argument. Others do not.

\n";

$UsageShort = "$ProgramName -- versatile line-based file updating tool\n";
$UsageShort .= " Options: [-r] [-m] [-i AFTER|-f BEFORE|-t] [-b START -e STOP] [-c CHAR] PACKAGE FILE\n";
$UsageShort .= " or type  $ProgramName --help  to be choked with help.\n";

my ($MarkBegin, $MarkEnd, $Trailer, $ParamBegin, $ParamEnd, $Placement,
    $Package, $File, $Block, $Multi, $InsertRemove, $Comment, $CommentEnd,
    $MatchLine, $RegexpMatch, $StdinContent, $NewContent, $InPlace,
    $NoClose, $FileHandle, @Lines, $LinesCount);

# Placement modes
use constant APPEND_AT_END => 0;
use constant INSERT_BEFORE => 1;
use constant INSERT_AFTER  => 2;
use constant INSERT_ON_TOP => 3;

# InsertRemove modes
use constant DO_REMOVE => 0;
use constant DO_INSERT => 1;
use constant DO_CHANGE => 2;

# Operation defaults
$InsertRemove = DO_INSERT;
$Placement    = APPEND_AT_END;
$RegexpMatch  = 1;
$Comment      = '#';
$CommentEnd   = '';
$MatchLine    = '';
$InPlace      = 0;
$NoClose      = 0;

while (@ARGV) {
  $_ = shift;
  if (/^-c$/ || /^--comment$/) {
    defined ($Comment = shift)
      || die "$ProgramName: `-c|--comment' must be followed by an argument\n";
  }
  elsif (/^--comment-end$/) {
    defined ($CommentEnd = shift)
      || die "$ProgramName: `--comment-end' must be followed by an argument\n";
  }
  elsif (/^-r$/ || /^--remove$/) {
    $InsertRemove = DO_REMOVE;
  }
  elsif (/^-x$/ || /^--change$/) {
    $InsertRemove = DO_CHANGE;
  }
  elsif (/^-m$/ || /^--allow-multi(?:ple)?$/) {
    $Multi = 1;
  }
  elsif (/^-b$/ || /^--begin(?:-mark)?$/) {
    defined ($ParamBegin = shift)
      || die "$ProgramName: '-b|--begin-mark' must be followed by an argument\n";
    $Block = 1;
  }
  elsif (/^-e$/ || /^--end(?:-mark)?$/) {
    defined ($ParamEnd = shift)
      || die "$ProgramName: '-e|--end-mark' must be followed by an argument\n";
    $Block = 1;
  }
  elsif (/^-i$/ || /^--insert-after$/) {
    defined($MatchLine = shift)
      || die "$ProgramName: '-i|--insert-after' must be followed by an argument\n";
    $Placement = INSERT_AFTER;
  }
  elsif (/^-f$/ || /^--insert-before$/) {
    defined($MatchLine = shift)
      || die "$ProgramName: '-f|--insert-before' must be followed by an argument\n";
    $Placement = INSERT_BEFORE;
  }
  elsif (/^-t$/ || /^--insert-on-top$/) {
    $Placement = INSERT_ON_TOP;
  }
  elsif (/^-R$/ || /^--regexp(?:-match|-mode)?$/) {
    $RegexpMatch = 1; # it's the default
  }
  elsif (/^-h$/ || /^--help$/) {
    die $UsageLong;
  }
  elsif (/^-p$/ || /^--in-place$/) {
    $InPlace = 1;
  }
  elsif (/^-n$/ || /^--no-close$/) {
    $NoClose = 1;
  }
  elsif (/^--version$/) {
    die "$ProgramName (CARNet Packaging file update) $VERSION\n"
    .   "Copyright (C) 1998-2005 Free Software Foundation, Inc.\n"
    .   "This is free software; see the source for copying conditions.  There is NO\n"
    .   "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n";
  }
  elsif (/^-/) {
    die "$ProgramName: Unrecognized option \`$_'\n";
  }
  else {
    unshift(@ARGV, $_);
    last;
  }
  
  if ($Multi and DO_CHANGE == $InsertRemove) {
    die "$ProgramName: Cannot use both `--change' and `--allow-multiple'\n";
  }
}

$Package = shift  or  die $UsageShort;
$File    = shift  or  die $UsageShort;

# prepare block begin and end marks
#
(! $Block || ($ParamBegin && $ParamEnd))
  or die ("$ProgramName: must provide both begin and end marks.\n");
#
if ($Block) {
  $ParamBegin =~ s,  %P  ,  $Package  ,gx;
  $ParamBegin =~ s,  %%  ,  %         ,gx;
  $ParamEnd   =~ s,  %P  ,  $Package  ,gx;
  $ParamEnd   =~ s,  %%  ,  %         ,gx;
  $MarkBegin  = $ParamBegin;
  $MarkEnd    = $ParamEnd;
  $Trailer    = '';
} else {
  $MarkBegin  = "$Comment Begin update by CARNet package $Package";
  $MarkEnd    = "$Comment End update by CARNet package $Package";
  $Trailer    = " -- DO NOT DELETE THIS LINE!".$CommentEnd;
}

DEBUG and print STDERR "MarkBegin='$MarkBegin'\nMarkEnd='$MarkEnd'\nTrailer='$Trailer'\n";

# compile regexp if provided
#
if ($RegexpMatch) {
  # compile user's regexp
  eval { $MatchLine = qr<$MatchLine> };
}
else {
  # we'll do regexp matching anyway :)
  # just not with user's specials interfering
  eval { $MatchLine = qr<^\Q$MatchLine\E>o; };
}
if ($@) {
  die "$ProgramName: regexp compilation failed: $@ ($!)\n";
}

do_it() and exit(0);


# main procedure
# --------------

sub do_it {
  $LinesCount = slurp();
  if (DO_CHANGE == $InsertRemove) {
    $StdinContent = &stdin_content;
    change() or add();
  }
  elsif (DO_INSERT == $InsertRemove) {
    $StdinContent = &stdin_content;
    del() unless $Multi;
    add();
  }
  else {
    del();
  }
  actualize();
}


# subroutines
# -----------

sub slurp() {
  sysopen($FileHandle, $File, O_RDWR) or die "$ProgramName: Cannot open $File: $!\n";
  @Lines = <$FileHandle>;  # slurp the whole file as lines
  close($FileHandle) unless ($InPlace && $NoClose);

  # If FILE does not have a trailing newline, be sure to add it
  # before appending anything else.
  if (@Lines and $Lines[$#Lines] !~ m/\n$/s) {
    $Lines[$#Lines] .= "\n";
  }
  
  return scalar @Lines;
}

sub add() {
  if (APPEND_AT_END == $Placement) {
    # append stuff at the end of the file
    push(@Lines, $StdinContent);
  }
  elsif (INSERT_ON_TOP == $Placement) {
    # throw the stuff on top of the file
    unshift(@Lines, $StdinContent);
  }
  else {
    # insert stuff where needed
    my ($line, $lineNo, $added);
    $lineNo = 0;
    $added  = 0;
    foreach $line (@Lines) {
      DEBUG and print STDERR "at: $line";
      if ($line =~ m/$MatchLine/) {
	DEBUG and print STDERR "  - MATCH\n";
	if (INSERT_AFTER == $Placement) {
	  DEBUG and print STDERR "    - INSERT_AFTER\n";
	  splice(@Lines, $lineNo + 1, 0, $StdinContent);
	}
	elsif (INSERT_BEFORE == $Placement) {
	  DEBUG and print STDERR "    - INSERT_BEFORE\n";
	  splice(@Lines, $lineNo, 0, $StdinContent);
	}
	# once added and we're done
	$added = 1;
	last;
      }
      ++ $lineNo;
    }
    if ($MatchLine and ! $added) {
      warn "$ProgramName: Inserting lines at the end implicitly! No '$MatchLine'\n";
      push(@Lines, $StdinContent);
    }
  }
  # add the number of lines in added content to safety counter
  $LinesCount += ($StdinContent =~ tr/\n//);
  return $LinesCount; # whatever true
}

sub del() {
  my ($mytrailer, $mybegin, $myend) =
    ($Trailer, $MarkBegin, $MarkEnd);

  my ($bm_found, $em_found); # begin/end mark found indicator

  # Make the strings regexp-friendly by quoting non-word chars.
  $mybegin   =~ s/\W/\\$&/g;
  $myend     =~ s/\W/\\$&/g;
  $mytrailer =~ s/\W/\\$&/g;

  my (@filtered);
  foreach (@Lines) {
    if (/^$mybegin(?:$mytrailer)?$/o .. /^$myend(?:$mytrailer)?$/o) {
      # additional safety counter for double-check
      -- $LinesCount;
    } else {
      push (@filtered, $_);
    }
    # for safety check:
    $bm_found = 1 if (/^$mybegin(?:$mytrailer)?$/o);
    $em_found = 1 if (/^$myend(?:$mytrailer)?$/o);
  }
  if ($bm_found and $em_found) {
    DEBUG and print STDERR "Deleted ". (@Lines - @filtered) ." out of ".scalar(@Lines)." lines\n";
    @Lines = @filtered;
  }
  elsif ($bm_found and ! $em_found) {
    # safety exit    
    die "$ProgramName: no end-mark after begin-mark!\n";
  }
  return $LinesCount; # whatever
}

sub change() {
  my ($mytrailer, $mybegin, $myend) =
    ($Trailer, $MarkBegin, $MarkEnd);

  my ($bm_found, $em_found); # begin/end mark found indicator

  # Make the strings regexp-friendly by quoting non-word chars.
  $mybegin   =~ s/\W/\\$&/g;
  $myend     =~ s/\W/\\$&/g;
  $mytrailer =~ s/\W/\\$&/g;

  my (@filtered, $done, $skip);
  $done = 0; # job done once
  $skip = 0; # skip original block
  foreach (@Lines) {
    if (! $done and $skip > 0) {
      -- $LinesCount;
      if (/^$myend(?:$mytrailer)?$/o) {
        ++ $done; # skipped all that was to skip
      } else {
        ++ $skip; # count lines being skipped
      }
    }
    elsif (0 == $skip and $_ =~ /^$mybegin(?:$mytrailer)?$/o) {
      push (@filtered, $StdinContent);
      $LinesCount += ($StdinContent =~ tr/\n//);
      $skip = 1;
    }
    else {
      push (@filtered, $_)
    }
    # for safety check:
    $bm_found = 1 if (/^$mybegin(?:$mytrailer)?$/o);
    $em_found = 1 if (/^$myend(?:$mytrailer)?$/o);
  }
  if ($bm_found and $em_found) {
    -- $skip; # correct the counter
    DEBUG and print STDERR "Replaced block of $skip lines\n";
    @Lines = @filtered;
  }
  elsif ($bm_found and ! $em_found) {
    # safety exit    
    die "$ProgramName: no end-mark after begin-mark!\n";
  }
  return $done;
}

# written by ddzeko@srce.hr, 2005-03-18
# to improve reliabilitah :)
#
sub actualize() {
  # put it all thogether
  my $newContent = join('', @Lines);

  unless (length($newContent) or 0 == $LinesCount) {
    # safety exit in last second :)
    die "$ProgramName: New content empty -- aborting file alteration!\n";
  }
  
  if ($InPlace) {
    # Provdided as means of changing the file content
    #    and keeping it's inode number still.
    # -------------------------------------------------------
    # this is dangerous since it can leave file in bad state
    # do not use this for highly critical files (ie. inittab)
    # -------------------------------------------------------
    # (REVISIT: add File::Copy call to back-up the file so
    #   we can at least try undoing the file content change)
    # backup_copy();
    unless (fileno($FileHandle)) {
      sysopen($FileHandle, $File, O_WRONLY|O_TRUNC)
	or die "$ProgramName: Failed to open file '$File' for writing ($!)\n";
    }
    else {
      sysseek(*$FileHandle, 0, SEEK_SET)
	or die "$ProgramName: Failed to seek to the begining of file ($!)\n";
    }
    if (length($newContent)) {
      my $wb = syswrite($FileHandle, $newContent);
      if (! $wb or length($newContent) != $wb) {
        # FIXME: try restoring backup copy
        my $ncl = length($newContent);
        die "$ProgramName: Failed to write the content to '$File' (wb=$wb, len=$ncl, err:$!)\n";
      }
    }
    if ($NoClose) {
      # this could be handy for files that had stuff appended
      # at the end of the file
      truncate($FileHandle, length($newContent))
	or die "$ProgramName: Failed to truncate the file ($!)\n";
    }
    close($FileHandle);
  }
  else {
    my ($file_new, $file_old) = ($File, $File);
    $file_new .= '.cp-update.new'; # our .new file
    $file_old .= '.cp-update.old'; # our .old file
    # write content in new file in single write op
    sysopen ($FileHandle, $file_new, O_CREAT|O_TRUNC|O_WRONLY, (stat($File))[2])
      or die "$ProgramName: Failed to open file '$File' for writing ($!)\n";
    if (length($newContent)) {
      my $wb = syswrite($FileHandle, $newContent);
      if (! $wb or length($newContent) != $wb) {
        unlink($file_new);
        my ($ncl) = length($newContent);
        die "$ProgramName: Failed to write the content to '$File' (wb=$wb, len=$ncl, err:$!)\n";
      }
    }
    close($FileHandle);
    # do the moving (should be atomic)
    
    eval { require File::Copy; };
    if ($@) {
      # do it the classical way: successive renames
      rename($File, $file_old)
        or die "$ProgramName: Failed to rename file '$File' to '$file_old' ($!)\n";
    }
    else {
      import File::Copy;
      # do it with increased safety: overstepping 
      #      the old file with it's modified copy
      copy($File, $file_old)
        or die "$ProgramName: Failed to create backup of '$File' as '$file_old' ($!)\n";
      # if the filesystem is absolutelly filled up this will fail 
      # and the original file will remain unchanged
    }
    rename($file_new, $File)
      or die "$ProgramName: Failed to rename file '$file_new' to '$File' ($!)\n";
    unlink($file_old)
      or warn "$ProgramName: Failed to remove file '$file_old' ($!)\n";
  }
  DEBUG and print STDERR "actualize: LinesCount=$LinesCount\n";
}

# return content from standard input
sub stdin_content() {
  my ($stdin_content) = join('', <STDIN>);
  unless (length($stdin_content)) {
    die "$ProgramName: No stdin-content provided!\n";
  }
  if ($stdin_content !~ m/\n$/s) {
    # add trailing newline
    $stdin_content .= "\n";
  }

  my ($mytrailer, $mybegin, $myend) =
    ($Trailer, $MarkBegin, $MarkEnd);

  $mytrailer .= "\n";
  $mybegin  .= $mytrailer;
  $myend    .= $mytrailer;
 
  $stdin_content = ($mybegin . $stdin_content . $myend);
  return $stdin_content;
}

# create backup copy of altered file
sub backup_copy() {
  die "$ProgramName: backup_copy() not implemented";
}