source: dasscm/trunk/usr/bin/dasscm@ 915

#!/usr/bin/perl -w

# $Id: dasscm 915 2010-07-16 16:28:10Z joergs $

use strict;

use Env
  qw($DASSCM_PROD $DASSCM_REPO $USER $DASSCM_USERNAME $DASSCM_USER $DASSCM_PASSWORD $SHELL);
use Cwd;
use Getopt::Long;
use File::Basename;
use File::Compare;
## used system("cp -a"), because File::Copy does not keep permissions
##use File::Copy;
use File::Find;
use File::stat;
use File::Path;
use Term::ReadKey;

use Data::Dumper;

#####################################################################
#
# global
#

# shell exit codes
my $RETURN_OK  = 0;
my $RETURN_NOK = 1;

# Nagios return codes
my $RETURN_WARN    = 1;
my $RETURN_CRIT    = 2;
my $RETURN_UNKNOWN = 3;

# documentation file (for usage)
my $doc_file = "/usr/share/doc/packages/dasscm/dasscm_howto.txt";

my $config_file = "/etc/dasscm.conf";
my $config      = get_config($config_file);

my @OPTIONS_GLOBAL = ( 'help', 'verbose' );

my %COMMANDS = (
    'help'              => 'help',
    'login'             => 'login',
    'init'              => 'init',
    'ls'                => 'ls',
    'update'            => 'update',
    'up'                => 'update',
    'add'               => 'add',
    'commit'            => 'commit',
    'checkin'           => 'commit',
    'ci'                => 'commit',
    'revert'            => 'revert',
    'blame'             => 'blame',
    'diff'              => 'diff',
    'status'            => 'status',
    'st'                => 'status',
    'check'             => 'check',
    'permissions'       => 'permissions',
    'cleanup'           => 'cleanup',
    'complete'          => 'complete',
    'complete_path'     => 'complete_path',
    'complete_repopath' => 'complete_repopath',
);

# desc: description (eg. for usage)
# params: parameters
#           CMD
#           USER
#           PATH_PROD
#           PATH_REPO
# require:
#           WRITE commands that require write access (and therefore a login)
my %COMMAND_DEFINITIONS = (
    'help' => {
        'desc'     => ["print help and usage information"],
        'params'   => ["CMD"],
        'function' => \&help,
    },
    'login' => {
        'desc'     => ["user login to Subversion repositoty"],
        'params'   => ["USER"],
        'function' => \&login
    },
    'init' => {
        'desc' => [
            "initialize local subversion checkout.",
            "This is the first thing to do (after configuring $config_file)"
        ],
        'params'   => [],
        'function' => \&init
    },
    'ls' => {
        'desc'     => ["list file from repository"],
        'params'   => ["PATH_REPO"],
        'function' => \&ls
    },
    'update' => {
        'desc' => [
            "update local repository checkout",
            "Normally, this is done automatically"
        ],
        'params'   => ["PATH_REPO"],
        'function' => \&update
    },
    'add' => {
        'desc' => [
            "add a file to the subversion repository",
            "Unlike the native svn command,",
            "dasscm adds and immediatly submits a file to the subversion repository"
        ],
        'params'   => ["PATH_PROD"],
        'options'  => [ 'verbose', 'message=s' ],
        'require'  => ["WRITE"],
        'function' => \&add
    },
    'commit' => {
        'desc' => ["commit a changed file to the subversion repository"],
        ## TODO: only modified files
        'params'   => ["PATH_REPO"],
        'options'  => [ 'verbose', 'message=s' ],
        'require'  => ["WRITE"],
        'function' => \&commit
    },
    'revert' => {
        'desc' => [
            "revert local changes back to version from the repository (see diff)"
        ],
        'params'   => ["PATH_REPO"],
        'function' => \&revert
    },
    'blame' => {
        'desc' => ['like "svn blame"'],
        ## TODO: only files from PATH_REPO
        'params'   => ["PATH_REPO"],
        'function' => \&blame
    },
    'diff' => {
        'desc' => [
            'display the differences between files on the system and the repository'
        ],
        'params'   => ["PATH_REPO"],
        'function' => \&diff
    },
    'status' => {
        'desc' => [
            'display status information about modified and deleted files.',
            'If no path is given "/" is assumed',
            '(in contract to "svn" with assumes ".")'
        ],
        'params'   => ["PATH_REPO"],
        'function' => \&status
    },
    'check' => {
        'desc'     => ["perform Nagios NRPE conform check"],
        'params'   => [],
        'function' => \&check
    },
    'permissions' => {
        'desc' =>
          ["internal, used to update information about file permissions"],
        'params'   => [],
        'function' => \&permissions
    },
    'cleanup' => {
        'desc'     => ["internal, used to clean repository checkout"],
        'params'   => [],
        'function' => \&cleanup
    },
    'complete' => {
        'desc'     => ["internal, used for bash completion"],
        'params'   => ["CMD"],
        'function' => \&complete
    },
    'complete_path' => {
        'desc'     => ["internal, used for bash completion"],
        'params'   => [],
        'function' => \&complete_path
    },
    'complete_repopath' => {
        'desc'     => ["internal, used for bash completion"],
        'params'   => [],
        'function' => \&complete_repopath
    },
);

# configuration file
my $DASSCM_LOCAL_REPOSITORY_BASE;
my $DASSCM_REPOSITORY_NAME;
my $DASSCM_SVN_REPOSITORY;
my $DASSCM_CHECKOUT_USERNAME;
my $DASSCM_CHECKOUT_PASSWORD;
my $DASSCM_PERMISSION_FILE;

# current directory at program start
my $StartDirectory = cwd();

my $diff                   = "diff --exclude .svn ";
my $SVN                    = "svn ";
my $svnOptions             = "";
my $svnCheckoutCredentials = "";
my $svnPasswordCredentials = "";

# flag. Set to true by svn_update
# This prevents, that svn_update is called multiple times
my $svnRepositoryIsUptodate = 0;

# command line options get stored in options hash
my %options = ();

# subcommand, that gets executed (add, commit, ...)
my $command;

my $verbose = 0;

#####################################################################
#
# util functions
#
sub usage()
{
    print '$Id: dasscm 915 2010-07-16 16:28:10Z joergs $';
    print "\n\n";
    print "usage: dasscm <subcommand> [options] [args]\n";
    print "\n";
    print "dasscm is intended to help versioning configuration files\n";
    print "\n";
    print "Available subcommands:\n";
    foreach my $i ( sort keys(%COMMAND_DEFINITIONS) ) {
        print "    ", $i, " ", join( " ", get_command_possible_params($i) ),
          "\n";
        foreach my $line ( get_command_desc($i) ) {
            print " " x 20, $line, "\n";
        }
    }
    print "\n";
    print "If dasscm is not yet configured, read $doc_file\n";
}

sub warning(@)
{
    print "Warning: " . join( "\n         ", @_ ) . "\n";
}

sub error(@)
{
    print "Error:   " . join( "\n         ", @_ ) . "\n";
}

sub fatalerror(@)
{
    error(@_);

    #print "Exiting\n";
    exit 1;
}

#
# reading config file and return key/value pairs as hash
#
sub get_config
{
    my $file = $_[0];

    if ( !$file ) {
        fatalerror( "failed to open config file" . $file );
    }

    my $data = {};

    # try to open config file
    if ( !open( FH, $file ) ) {
        fatalerror( "failed to open config file" . $file );
    } else {
        while (<FH>) {
            chomp;
            if (/^#/) {
                next;
            }
            if ( $_ =~ /=/g ) {

                # splitting in 2 fields at maximum
                my ( $option, $value ) = split( /=/, $_, 2 );
                $option =~ s/^\s+//g;
                $option =~ s/\s+$//g;
                $option =~ s/\"+//g;
                $value  =~ s/^\s+//g;
                $value  =~ s/\s+$//g;
                $value  =~ s/\"+//g;

                if ( length($option) ) {
                    $data->{$option} = $value;
                }
            }
        }
    }
    close(FH);

    return $data;
}

#
# check and evaluate environment variables
#
sub check_env()
{

    # DASSCM_PROD
    if ( !$DASSCM_PROD ) {
        $DASSCM_PROD = "/";
    }

    if ( !-d $DASSCM_PROD ) {
        die "DASSCM_PROD ($DASSCM_PROD) is not set to a directory.\n";
    }
    if ($verbose) { print "DASSCM_PROD: " . $DASSCM_PROD . "\n"; }

    # DASSCM_REPOSITORY_NAME
    if ( !$DASSCM_REPOSITORY_NAME ) {
        die
          "Variable DASSCM_REPOSITORY_NAME is not defined.\nIt needs to be a unique name.\nNormally the full qualified host name is used.\nUse file $config_file to configure it.\n";
    }

    # DASSCM_REPO
    if ( !$DASSCM_REPO ) {
        if ( $DASSCM_LOCAL_REPOSITORY_BASE && $DASSCM_REPOSITORY_NAME ) {
            $DASSCM_REPO =
              $DASSCM_LOCAL_REPOSITORY_BASE . "/" . $DASSCM_REPOSITORY_NAME;
        } else {
            die
              "Envirnonment variable DASSCM_REPO not set.\nSet DASSCM_REPO to the directory of the versioning system checkout for this machine.\n";
        }
    }
    $DASSCM_REPO = normalize_path($DASSCM_REPO);
    if ($verbose) { print "DASSCM_REPO: " . $DASSCM_REPO . "\n"; }

    #
    # subversion checkout user
    #
    if ( !$DASSCM_CHECKOUT_USERNAME ) {
        fatalerror(
            "variable DASSCM_CHECKOUT_USERNAME is not defined.",
            "Use file $config_file to configure it."
        );
    }

    if ( !$DASSCM_CHECKOUT_PASSWORD ) {
        fatalerror(
            "variable DASSCM_CHECKOUT_PASSWORD is not defined.",
            "Use file $config_file to configure it."
        );
    }

    #
    # check if local repository directory exist
    # (if not creating by init)
    #
    if ( $command ne "init" ) {
        if ( not -d $DASSCM_REPO ) {
            die
              "Can't access local repository DASSCM_REPO\n($DASSCM_REPO)\nCheck configuration and execute\n    dasscm init\n";
        }

        #
        # user settings
        #

        # DASSCM_USER is legacy. Use DASSCM_USERNAME instead
        if ( !$DASSCM_USERNAME ) {
            $DASSCM_USERNAME = $DASSCM_USER;
        }

        # user root is not allowed for checkins.
        # if user is root, DASSCM_USER has to be set,
        # otherwise USER can be used
        if ( "$USER" eq "root" ) {
            if (    ( not $DASSCM_USERNAME )
                and ( get_command_requires_write($command) ) )
            {

                #( $command ne "login" ) and ( $command ne "status" ) ) {
                fatalerror(
                    "Envirnonment variable DASSCM_USERNAME not set.",
                    "Set DASSCM_USERNAME to your subversion user account or",
                    "use 'dasscm login'"
                );
            }
            $svnOptions .= " --no-auth-cache ";
        } elsif ( !$DASSCM_USERNAME ) {
            $DASSCM_USERNAME = $USER;
        }

        #
        # password
        #
        if ($DASSCM_PASSWORD) {
            $svnPasswordCredentials = " --password '$DASSCM_PASSWORD' ";
        }
    }

    #$svnOptions .= " --username $DASSCM_USERNAME "
}

#
# has been intendend,
# to check addtitional parameters.
# Currently not used.
#
sub check_parameter(@)
{
}

sub get_command_uniform_name( $ )
{
    my $command_abbrivation = $_[0];
    if ( defined( $COMMANDS{$command_abbrivation} ) ) {
        return $COMMANDS{$command_abbrivation};
    }
    return;
}

sub get_command_desc( $ )
{
    my $command = get_command_uniform_name( $_[0] );
    my @desc    = ();
    if ( $command && defined( $COMMAND_DEFINITIONS{$command}{'desc'} ) ) {
        @desc = @{ $COMMAND_DEFINITIONS{$command}{'desc'} };
    }
    return @desc;
}

sub get_command_function( $ )
{
    my $command = get_command_uniform_name( $_[0] );
    my $func;
    if ( $command && defined( $COMMAND_DEFINITIONS{$command}{'function'} ) ) {
        $func = $COMMAND_DEFINITIONS{$command}{'function'};
    }
    return $func;
}

sub get_command_possible_params( $ )
{
    my $command = get_command_uniform_name( $_[0] );
    my @params  = ();
    if ( $command && defined( $COMMAND_DEFINITIONS{$command}{'params'} ) ) {
        @params = @{ $COMMAND_DEFINITIONS{$command}{'params'} };
    }
    return @params;
}

sub get_command_possible_options( $ )
{
    my $command = get_command_uniform_name( $_[0] );
    my @params  = ();
    if ( $command && defined( $COMMAND_DEFINITIONS{$command}{'options'} ) ) {
        @params = @{ $COMMAND_DEFINITIONS{$command}{'options'} };
    }
    return @params;
}

sub get_command_requirements( $ )
{
    my $command      = get_command_uniform_name( $_[0] );
    my @requirements = ();
    if ( $command && defined( $COMMAND_DEFINITIONS{$command}{'require'} ) ) {
        @requirements = @{ $COMMAND_DEFINITIONS{$command}{'require'} };
    }
    return @requirements;
}

sub get_command_requires_write( $ )
{
    return grep( /^WRITE$/, get_command_requirements( $_[0] ) );
}

#
# normalize path namens:
#   - directories should end with "/"
#   - use only single "/"
#
sub normalize_path($)
{
    my $path = shift || "";

    if ( $path =~ m|^/| ) {

        # full path
        if ( -d $path ) {

            # ensure, a directory ends with '/'
            $path .= '/';
        }
    } elsif ( -d cwd() . '/' . $path ) {

        # ensure, a directory ends with '/'
        $path .= '/';
    }

    # remove double (triple) slashes (/)
    $path =~ s|/[/]*|/|g;

    # remove self reference path
    $path =~ s|/./|/|g;

    return $path;
}

#
# generate from (relative) filename
# all required file and directory names:
# $basename,      $dirname_prod, $dirname_repo,
# $filename_prod, $filename_repo
#
sub get_filenames(@)
{
    my $filename_prod = $_[0] || ".";

    # make filename absolut
    if ( !( $filename_prod =~ m/^\// ) ) {
        $filename_prod = cwd() . '/' . $filename_prod;
    }

    # file must be readable.
    # The only exceptions are,
    # - if the file parameter is to be completed or
    # - if a file should be reverted
    if ( $command ne "revert" && $command !~ m/^complete/ ) {
        if ( not -r $filename_prod ) {
            fatalerror( $filename_prod . " is not accessable" );
        }
    }

    # dirname buggy: eg. "/etc/" is reduced to "/",
    # "/etc" is used as filename
    # herefore make sure, that if filename is a directory,
    # it will end by "/"
    $filename_prod = normalize_path($filename_prod);

    ( my $basename, my $dirname_prod ) = fileparse($filename_prod);

    # normalize path.
    # not done for reverting, because in this case, the directory may not exist
    # and the correct path should already be stored in the repository
    if ( $command ne "revert" ) {

        # uses chdir to determine real directory in a unique way
        chdir $dirname_prod
          or fatalerror( "failed to access directory $dirname_prod: " . $! );
        $dirname_prod = normalize_path( cwd() );
        chdir $StartDirectory;
    }

    my $dirname_repo  = normalize_path( $DASSCM_REPO . "/" . $dirname_prod );
    my $filename_repo = normalize_path("$dirname_repo/$basename");

    if ($verbose) {
        print "filename_repo:  " . $filename_repo . "\n";
        print "dirname_repo:   " . $dirname_repo . "\n";
        print "filename_prod:  " . $filename_prod . "\n";
        print "dirname_prod:   " . $dirname_prod . "\n";
        print "basename:       " . $basename . "\n";
    }

    return (
        $basename,      $dirname_prod, $dirname_repo,
        $filename_prod, $filename_repo
    );
}

sub copy_file_to_repository( $ )
{
    my $filename = shift;

    (
        my $basename,
        my $dirname_prod,
        my $dirname_repo,
        my $filename_prod,
        my $filename_repo
    ) = get_filenames($filename);

    #copy( $filename_prod, $filename_repo )
    ( my $rc, my @result ) =
      run_command("cp -a \"$filename_prod\" \"$filename_repo\"");
    if ( $rc != 0 ) {
        error( "failed to copy $filename_prod to repository: ", @result );
    }

    # return success
    return $rc == 0;
}

sub copy_file_from_repository_to_system( $ )
{
    my $filename = shift;

    (
        my $basename,
        my $dirname_prod,
        my $dirname_repo,
        my $filename_prod,
        my $filename_repo
    ) = get_filenames($filename);

    ( my $rc, my @result ) =
      run_command("cp -a \"$filename_repo\" \"$filename_prod\"");
    if ( $rc != 0 ) {
        error( "failed to copy $filename_repo to $filename_prod: ", @result );
    }

    # return success
    return $rc == 0;
}

#
# creates a file with permissions
#
sub generatePermissionList
{

    # generieren der Zeilen für Permission-Savefile
    my @files    = @_;
    my @permlist = ();
    foreach my $file (@files) {
        $file = "/" . $file;
        if ( -e $file ) {
            my $info = stat($file) || die "failed to stat $file: aborting";
            my $mode = get_type( $info->mode ) & 07777;
            my $modestring = sprintf( "%04o", $mode );
            my $uidnumber  = $info->uid;
            my $uid        = getpwuid($uidnumber) || $uidnumber;
            my $gidnumber  = $info->gid;
            my $gid        = getgrgid($gidnumber) || $gidnumber;
            push(
                @permlist,
                sprintf( "%-55s %-17s %4d",
                    $file, "${uid}:${gid}", $modestring )
            );
        }
    }
    return @permlist;
}

sub get_type
{

    # Funktion übernommen aus /usr/bin/chkstat
    my $S_IFLNK  = 0120000;    # symbolic link
    my $S_IFREG  = 0100000;    # regular file
    my $S_IFDIR  = 0040000;    # directory
    my $S_IFCHAR = 0020000;    # character device
    my $S_IFBLK  = 0060000;    # block device
    my $S_IFFIFO = 0010000;    # fifo
    my $S_IFSOCK = 0140000;    # socket
    my $S_IFMT   = 0170000;    # type of file

    my $S_m;
    if    ( ( $_[0] & $S_IFMT ) == $S_IFLNK )  { $S_m = $_[0] - $S_IFLNK; }
    elsif ( ( $_[0] & $S_IFMT ) == $S_IFREG )  { $S_m = $_[0] - $S_IFREG; }
    elsif ( ( $_[0] & $S_IFMT ) == $S_IFDIR )  { $S_m = $_[0] - $S_IFDIR; }
    elsif ( ( $_[0] & $S_IFMT ) == $S_IFCHAR ) { $S_m = $_[0] - $S_IFCHAR; }
    elsif ( ( $_[0] & $S_IFMT ) == $S_IFBLK )  { $S_m = $_[0] - $S_IFBLK; }
    elsif ( ( $_[0] & $S_IFMT ) == $S_IFFIFO ) { $S_m = $_[0] - $S_IFFIFO; }
    elsif ( ( $_[0] & $S_IFMT ) == $S_IFSOCK ) { $S_m = $_[0] - $S_IFSOCK; }
    $S_m;
}

sub run_command
{
    my $command = shift;

    #print "executing command: " . $command . "\n";

    open( RESULT, $command . ' 2>&1 |' );
    my @result = <RESULT>;
    close(RESULT);
    my $retcode = $? >> 8;

    #print @result;
    #if( $retcode ) { print "return code: " . $retcode . "\n"; }

    return ( $retcode, @result );
}

sub run_interactive
{

    if ($verbose) {
        print "run_interactive:" . join( " ", @_ ) . "\n";
    }

    system(@_);
    if ( $? == -1 ) {
        printf "failed to execute: $!\n";
    } elsif ( $? & 127 ) {
        printf "child died with signal %d, %s coredump\n", ( $? & 127 ),
          ( $? & 128 ) ? 'with' : 'without';
    } elsif ( $? >> 8 != 0 ) {
        printf "child exited with value %d\n", $? >> 8;
    }
    return ( $? >> 8 );
}

sub svn_check_credentials( $$;$$ )
{
    my $username = shift;
    my $password = shift;

    # check silently are allow user interaction?
    my $interactive = shift || 0;

    # default: exit program, if repository is not accessable
    #   (do not exit for 'init')
    my $fatalerror = shift || 1;

    print "checking credentials ";

    if ( !$username ) {
        fatalerror("no username given");
    }

    if ( !$password ) {
        fatalerror("no password given");
    }

    print "for " . $username . "@" . $DASSCM_SVN_REPOSITORY . ": ";

    # Options for "svn info" are not supported by subversion 1.0.0 (SLES9),
    # therefore switching to "svn status"
    # ( my $rc_update, my @result ) =
    #     run_command(
    #     "$SVN info --non-interactive --no-auth-cache --username $username --password $password $DASSCM_SVN_REPOSITORY"
    #     );
    #print @result;

    my $rc_update;
    if ($interactive) {
        $rc_update = run_interactive(
            "$SVN ls --no-auth-cache --username '$username' --password '$password' $DASSCM_SVN_REPOSITORY"
        );
    } else {
        ( $rc_update, my @result ) = run_command(
            "$SVN ls --non-interactive --no-auth-cache --username '$username' --password '$password' $DASSCM_SVN_REPOSITORY"
        );

        if ( $rc_update != 0 ) {
            print "\n", @result;
            if ($fatalerror) {
                fatalerror();
            }
            return;
        }
    }

    # return success
    return $rc_update == 0;
}

sub svn_update( ;$ )
{
    my $update_path = shift || "";

    # return value
    my $update_ok = 1;

    # use this flag to do only one update per run
    if ( !$svnRepositoryIsUptodate ) {
        ( my $rc_update, my @result ) = run_command(
            "$SVN update --non-interactive $svnCheckoutCredentials '$DASSCM_REPO/$update_path'"
        );
        print @result;
        if ( $rc_update != 0 ) {
            error("failed to update local repository ($update_path)");
            $update_ok = 0;
        } elsif ( not $update_path ) {

            # set this flag if a full update is done
            $svnRepositoryIsUptodate = 1;
        }
    }
    return $update_ok;
}

sub svn_ls( ;@ )
{
    (
        my $basename,
        my $dirname_prod,
        my $dirname_repo,
        my $filename_prod,
        my $filename_repo
    ) = get_filenames( $_[0] );

    # svn ls -R is better, but much, much slower
    # ( my $rc, my @result ) = run_command("$SVN ls --recursive $svnCheckoutCredentials $path");

    my @files  = ();
    my @links  = ();
    my @dirs   = ();
    my @others = ();

    find(
        {
            wanted => sub {
                my $name = normalize_path($File::Find::name);
                $name =~ s|^$dirname_repo||;

                #print "($name)\n";# . $File::Find::dir . "\n";
                if ( not $name ) {

                    # name string is empty (top directory).
                    # do nothing
                } elsif ( $name =~ m/\.svn/ ) {

                    # skip svn meta data
                } elsif ( -l $_ ) {

                    # soft link
                    # important: check for links first
                    #   to exclude them from further checks
                    push( @links, $name );
                } elsif ( -d $_ ) {

                    # directories
                    push( @dirs, $name );
                } elsif ( -f $_ ) {

                    # regular file
                    push( @files, $name );
                } else {
                    push( @others, $name );
                }
              }
        },
        ($filename_repo)
    );

    return ( sort( @dirs, @files ) );
}

sub svn_revert( ;$ )
{
    my $path = shift || $DASSCM_REPO;

    ( my $rc_update, my @result ) = run_command("$SVN revert -R '$path'");

    if ( $rc_update != 0 ) {
        print "\n", @result;
        error("failed to revert subversion repository changes");
    }
}

sub svn_remove_unknown_files( ;$ )
{
    my $path = shift || $DASSCM_REPO;

    ( my $rc_update, my @result ) = run_command("$SVN status '$path'");

    if ( $rc_update != 0 ) {
        print "\n", @result;
        error("failed to receive subversion repository information");
    } else {
        foreach (@result) {
            if (s/^\? +//) {
                chomp;

                # if file is unknown to subversion (line starts with "?")
                # remove it
                print "removing $_\n";

                # unlink doesn't work recursive, there "rm -rf" is used
                #unlink($_);
                system("rm -rf $_");
            }
        }
    }
}

sub getModifiedFiles( ;$ )
{
    (
        my $basename,
        my $dirname_prod,
        my $dirname_repo,
        my $filename_prod,
        my $filename_repo
    ) = get_filenames( $_[0] );

    my @files = svn_ls($filename_prod);

    # stores result from status (cvscheck)
    my %removedfiles = ();
    my %changedfiles = ();
    my %unknownfiles = ();

    # create list of modified files
    if (@files) {

        foreach my $file (@files) {

            my $realfile    = $dirname_prod . $file;
            my $cvsworkfile = $dirname_repo . $file;

            if ( -d $realfile ) {

                # directory
                if ( !-d "$cvsworkfile" ) {

                    # real is directory, repository is not. This is a problem
                    $changedfiles{"$realfile"} = $cvsworkfile;
                }
            } elsif ( !-e $realfile ) {
                $removedfiles{"$realfile"} = $cvsworkfile;
            } elsif ( !-r $realfile ) {

                # don't have permission to read the file,
                # can't check it
                $unknownfiles{"$realfile"} = $cvsworkfile;
            } else {
                ( -r "$cvsworkfile" )
                  || fatalerror("failed to read $cvsworkfile");
                if ( compare( $cvsworkfile, $realfile ) != 0 ) {
                    $changedfiles{"$realfile"} = $cvsworkfile;
                }
            }
        }
    }

    return ( \%changedfiles, \%removedfiles, \%unknownfiles );
}

#
# from an array of files/dirs,
# generates list of files
# sorted by type
#
sub get_files( @ )
{
    my @files  = ();
    my @links  = ();
    my @dirs   = ();
    my @others = ();

    if (@_) {
        find(
            {
                wanted => sub {
                    my $fullname = cwd() . "/" . $_;
                    if ( -l $_ ) {

                        # soft link
                        # important: check for links first
                        #   to exclude them from further checks
                        push( @links, $fullname );
                    } elsif ( -d $_ ) {

                        # directories
                        push( @dirs, $fullname );
                    } elsif ( -f $_ ) {

                        # regular file
                        push( @files, $fullname );
                    } else {
                        push( @others, $fullname );
                    }
                  }
            },
            @_
        );
    }

    # don't rely on others.
    # If more specific file types are needed,
    # they will be added
    return {
        files  => \@files,
        links  => \@links,
        dirs   => \@dirs,
        others => \@others
    };
}

#
# use globbing to get lsit of files
# that matches the given prefix
# used for bash completion
#
sub get_complete_path_globbing( $ )
{
    my $path = shift;

    # add globbing
    $path .= "*";

    # get files
    my @files = glob($path);

    if ( $#files == 0 ) {

        # if only one result is available
        # and this result is a directory,
        # add another result entry
        # (directory with and withour trainling /),
        # otherwise complete will stop here and continue with the next parameter
        my $path = normalize_path( $files[0] );
        if ( -d $path ) {
            @files = ( substr( $path, 0, -1 ), $path );
        }
    } else {

        # add "/" to all directories
        @files = map( { normalize_path($_) } @files );
    }

    return @files;
}

#####################################################################
#
# functions
sub help(;@)
{
    if ( not @_ ) {
        usage();
    } else {
        print "help for ", join( " ", @_ ), ": ...\n";
        usage();
    }
}

sub login(@)
{
    check_parameter( @_, 1 );
    check_env();

    my $input_username = $_[0];

    if ( not $input_username ) {
        my $output_username = "";
        if ($DASSCM_USERNAME) {
            $output_username = " ($DASSCM_USERNAME)";
        }

        print "Enter DASSCM user name", $output_username, ": ";
        $input_username = <STDIN>;
        chomp($input_username);

        $input_username = $input_username || $DASSCM_USERNAME;
    }

    # hidden password input
    print "Enter password stty for $input_username: ";
    #ReadMode('noecho');
    `stty -echo`;
    my $input_password = <STDIN>;
    #ReadMode('normal');
    `stty echo`;
    chomp($input_password);
    print "\n";

    # checking checkout username/password
    svn_check_credentials( $DASSCM_CHECKOUT_USERNAME,
        $DASSCM_CHECKOUT_PASSWORD );
    print "checkout access okay\n";

    svn_check_credentials( $input_username, $input_password );

    #
    # set environment variables
    #
    $ENV{'DASSCM_USERNAME'} = "$input_username";
    $ENV{'DASSCM_PASSWORD'} = "$input_password";

    print "subversion access okay\n\n", "DASSCM_USERNAME:   $input_username\n",
      "DASSCM_PASSWORD:   (hidden)\n", "DASSCM_PROD:       $DASSCM_PROD\n",
      "DASSCM_REPO:       $DASSCM_REPO\n",
      "Server Repository: $DASSCM_SVN_REPOSITORY\n", "\n";

    status();

    print "\n[dasscm shell]\n\n";
    my $shell = $SHELL || "bash";
    exec($shell) or die "failed to start new shell";
}

#
# initialize local checkout directory (initial checkout)
#
sub init(@)
{
    check_parameter( @_, 1 );
    check_env();

    # don't do repository creation (svn mkdir) here,
    # because then their must be a lot of prior checks

    # update complete repository
    # and create permission file
    my $retcode = run_interactive(
        "cd $DASSCM_LOCAL_REPOSITORY_BASE; $SVN checkout $svnCheckoutCredentials $svnOptions $DASSCM_SVN_REPOSITORY; mkdir -p `dirname $DASSCM_PERMISSION_FILE`; touch $DASSCM_PERMISSION_FILE"
    );
}

sub ls(@)
{
    check_parameter( @_, 1 );
    check_env();

    my @files = svn_ls(@_);

    if (@files) {
        print join( "\n", @files );
        print "\n";
    }
}

sub update(@)
{
    check_parameter( @_, 1 );
    check_env();

    #
    # update local repository
    #
    svn_update();
}

#
# helper function for "add" command
#
sub add_helper(@)
{
    (
        my $basename,
        my $dirname_prod,
        my $dirname_repo,
        my $filename_prod,
        my $filename_repo
    ) = get_filenames( $_[0] );

    mkpath($dirname_repo);
    copy_file_to_repository($filename_prod);

    # already checked in?
    chdir $DASSCM_REPO;

    # also add the path to filename.
    for my $dir ( split( '/', $dirname_prod ) ) {
        if ($dir) {
            my ( $rc, @out ) = run_command("$SVN add --non-recursive '$dir'");
            if ( $rc > 0 ) {
                print join( "\n", @out );
            }
            chdir $dir;
        }
    }
    my ( $rc, @out ) = run_command("$SVN add '$basename'");
    if ( $rc > 0 ) {
        print join( "\n", @out );
    }
    chdir $StartDirectory;

}

#
# adding new files (or directories)
#
sub add(@)
{
    check_parameter( @_, 1 );
    check_env();

    #
    # update local repository
    #
    svn_update();

    # get all regular files and links
    my $href_files = get_files(@_);

    #print Dumper( $href_files );

    my @files = @{ $href_files->{files} };
    my @links = @{ $href_files->{links} };

    if (@files) {
        my $number = $#files + 1;
        print "files to check-in ($number): \n";
        print join( "\n", @files );
        print "\n";
    }

    # TODO: check in links and also link target? At least warn about link target
    if (@links) {
        my $number = $#links + 1;
        print "\n";
        print "ignoring links ($number):\n";
        print join( "\n", @links );
        print "\n";
    }

    # TODO: confirm

    # copy files one by one to local repository
    for my $file (@files) {

        # add file
        add_helper($file);
    }

    # create new permissions file
    permissions();

    # add permissions file
    add_helper($DASSCM_PERMISSION_FILE);

    if ( $options{'message'} ) {
        $svnOptions .= " --message \"$options{'message'}\" ";
    }

    # commit calls $EDITOR.
    # use "interactive" here, to display output
    my $retcode = run_interactive(
        "$SVN commit $svnOptions --username '$DASSCM_USERNAME' $svnPasswordCredentials $DASSCM_REPO"
    );

    # svn commit does not deliever an error return code, if commit is canceld,
    # so a revert is performed in any case
    svn_revert();
}

#
# checks in all modified files
#
sub commit(@)
{
    check_parameter( @_, 1 );
    check_env();

    (
        my $basename,
        my $dirname_prod,
        my $dirname_repo,
        my $filename_prod,
        my $filename_repo
    ) = get_filenames( $_[0] );

    #
    # update local repository
    #
    svn_update();

    ( my $refChangedFiles, my $refRemovedFiles ) =
      getModifiedFiles($filename_prod);
    my %changedfiles = %{$refChangedFiles};
    my %removedfiles = %{$refRemovedFiles};

    if (%removedfiles) {
        my $removedFilesString =
          '"' . join( '" "', values(%removedfiles) ) . '"';
        my ( $rc, @out ) = run_command("$SVN rm $removedFilesString");
        if ( $rc > 0 ) {
            print join( "\n", @out );
        }
    }

    # copy files one by one to local repository
    for my $file ( keys(%changedfiles) ) {
        copy_file_to_repository($file);
    }

    # create new permissions file
    permissions();

    # add permissions file
    add_helper($DASSCM_PERMISSION_FILE);

    if ( $options{'message'} ) {
        $svnOptions .= " --message \"$options{'message'}\" ";
    }

    # commit calls $EDITOR.
    # use "interactive" here, to display output
    my $retcode = run_interactive(
        "$SVN commit $svnOptions --username '$DASSCM_USERNAME' $svnPasswordCredentials $DASSCM_REPO"
    );

    # svn commit does not deliever an error return code, if commit is canceld,
    # so a revert is performed in any case
    svn_revert();
}

#
# revert: copies files back from repository to system
#
sub revert(@)
{
    check_parameter( @_, 1 );
    check_env();

    (
        my $basename,
        my $dirname_prod,
        my $dirname_repo,
        my $filename_prod,
        my $filename_repo
    ) = get_filenames( $_[0] );

    # return code for the shell
    # default: error
    my $return_code = $RETURN_OK;

    # cleanup repository
    cleanup();

    #svn_update();

    ( my $refChangedFiles, my $refRemovedFiles, my $refUnknownFiles ) =
      getModifiedFiles($filename_prod);
    my %changedfiles = %{$refChangedFiles};
    my %removedfiles = %{$refRemovedFiles};
    my %unknownfiles = %{$refUnknownFiles};

    if ( %removedfiles or %changedfiles or %unknownfiles ) {

        if (%removedfiles) {
            print "DELETED files and directories. Recreated from repository:\n";
            my @removedPaths =
              ( sort { length $a > length $b } keys %removedfiles );
            print join( "\n", @removedPaths ) . "\n\n";

            # copy files one by one from local repository to system
            # and also create directories
            # paths are sorted, so that directories are created first
            for my $real_path (@removedPaths) {
                if ( -d $removedfiles{"$real_path"} ) {
                    mkpath("$real_path");
                } else {
                    copy_file_from_repository_to_system($real_path);
                }
            }
        }

        if (%changedfiles) {
            print "MODIFIED files. Copied from repository to the system:\n";
            print join( "\n", ( keys %changedfiles ) ) . "\n\n";

            # copy files one by one from local repository to system
            for my $real_file ( keys(%changedfiles) ) {
                copy_file_from_repository_to_system($real_file);
            }

        }

        if (%unknownfiles) {
            print "UNKNOWN: insufficient permission to check files:\n";
            print join( "\n", ( keys %unknownfiles ) ) . "\n\n";

            $return_code = $RETURN_NOK;
        }

    } else {
        print "no modified files found in $dirname_repo\n";
    }

    return $return_code;
}

sub blame(@)
{
    check_parameter( @_, 1 );
    check_env();

    (
        my $basename,
        my $dirname_prod,
        my $dirname_repo,
        my $filename_prod,
        my $filename_repo
    ) = get_filenames( $_[0] );

    my $retcode = run_interactive("$SVN blame $svnOptions $filename_repo");
}

sub diff(@)
{
    check_parameter( @_, 1 );
    check_env();

    (
        my $basename,
        my $dirname_prod,
        my $dirname_repo,
        my $filename_prod,
        my $filename_repo
    ) = get_filenames( $_[0] );

    #print "$basename,$dirname_prod,$dirname_repo\n";

    svn_update();

    ( my $rc_diff, my @diff_result ) =
      run_command( $diff . " $filename_repo $filename_prod" );

    print @diff_result;
}

sub status(@)
{
    check_parameter( @_, 1 );
    check_env();

    (
        my $basename,
        my $dirname_prod,
        my $dirname_repo,
        my $filename_prod,
        my $filename_repo
    ) = get_filenames( $_[0] || "/" );

    # return code for the shell
    # default: error
    my $return_code = $RETURN_NOK;

    #
    # update local repository
    #
    #svn_update( $filename_prod );

    # check, if permissions have changed
    permissions();

    # get modified files
    ( my $refChangedFiles, my $refRemovedFiles, my $refUnknownFiles ) =
      getModifiedFiles($dirname_prod);
    my %changedfiles = %{$refChangedFiles};
    my %removedfiles = %{$refRemovedFiles};
    my %unknownfiles = %{$refUnknownFiles};

    if ( %removedfiles or %changedfiles or %unknownfiles ) {

        if (%removedfiles) {
            print "DELETED: files found in repository, but not in system:\n";
            print join( "\n", sort ( keys %removedfiles ) ) . "\n\n";
        }

        if (%changedfiles) {
            print "MODIFIED: files differs between repository and system:\n";
            print join( "\n", ( keys %changedfiles ) ) . "\n\n";
        }

        if (%unknownfiles) {
            print "UNKNOWN: insufficient permission to check files:\n";
            print join( "\n", ( keys %unknownfiles ) ) . "\n\n";
        }

    } else {
        print "no modified files found in $dirname_repo\n";
        $return_code = $RETURN_OK;
    }

    return $return_code;
}

#
# return short status in Nagios plugin conform way
#
sub check()
{
    check_env();

    # return code for the shell
    my $return_code   = $RETURN_OK;
    my $return_string = "OK: no modified files";

    # check, if permissions have changed
    permissions();

    # get modified files
    ( my $refChangedFiles, my $refRemovedFiles, my $refUnknownFiles ) =
      getModifiedFiles("/");
    my %changedfiles = %{$refChangedFiles};
    my %removedfiles = %{$refRemovedFiles};
    my %unknownfiles = %{$refUnknownFiles};

    if ( %removedfiles or %changedfiles ) {
        $return_string = "Warning: ";
        if (%changedfiles) {
            $return_string .=
              "changed: " . join( ", ", ( keys %changedfiles ) ) . ". ";
        }
        if (%removedfiles) {
            $return_string .=
              "removed: " . join( ", ", ( keys %removedfiles ) ) . ". ";
        }
        if (%unknownfiles) {
            $return_string .=
              "unknown: " . join( ", ", ( keys %unknownfiles ) ) . ". ";
        }
        $return_code = $RETURN_WARN;
    }

    # addition nagios Service Status
    #Critical
    #Unknown

    print "$return_string\n";
    return $return_code;
}

sub permissions()
{
    check_env();

    my $return_code = $RETURN_OK;

    #
    # update local repository
    #
    #svn_update();

    my $dir   = $DASSCM_REPO;
    my @files = svn_ls("/");

    if (@files) {

        # generieren der Permissions
        my @permissions = generatePermissionList(@files);
        my $OUTFILE;
        my $tofile = 0;    # Status für schreiben in File

        if ( -w dirname($DASSCM_PERMISSION_FILE) ) {

            # Verzeichnis existiert => schreiben
            open( OUTFILE, ">$DASSCM_PERMISSION_FILE" )
              || die("failed to write to $DASSCM_PERMISSION_FILE: $!");
            $tofile = 1;    # Merken, daß in File geschrieben wird
            print OUTFILE "#\n";
            print OUTFILE "# created by dasscm permissions\n";
            print OUTFILE
              "# It is intended to be used for restoring permissions\n";
            print OUTFILE "#\n";
        } else {

            if ( $command eq "permission" ) {

                # Pfad für Sicherungsdatei existiert nicht => schreiben auf stdout
                # Alias Filehandle für stdout erzeugen
                $return_code = $RETURN_WARN;
                *OUTFILE     = *STDOUT;
            } else {

                # TODO: improve this. Check for diff?
                $return_code = $RETURN_CRIT;
                return $return_code;
            }
        }

        foreach my $line (@permissions) {
            print OUTFILE "$line\n";
        }

        if ($tofile) {
            close(OUTFILE);
        }
    }

    return $return_code;
}

#
# remove all uncommited changes in the repository
#
sub cleanup()
{
    check_env();

    svn_revert($DASSCM_REPO);
    svn_remove_unknown_files($DASSCM_REPO);
}

#
# used for bash completion
# prints the next possible command line parameters
#
sub complete(@)
{
    my @input            = @_;
    my %options_complete = ();

    # check and remove global options. if options are wrong, nothing to do
    @ARGV = @input;
    if ( GetOptions( \%options_complete, @OPTIONS_GLOBAL ) ) {
        my $number_arguments = @input;
        if ( $number_arguments <= 1 ) {

            # complete dasscm commands
            my $input = $input[0] || "";
            map { m/^$input/ && print $_, "\n" } ( keys %COMMANDS );
        } else {

            # complete dasscm parameter
            my $command = get_command_uniform_name( $input[0] );
            if ($command) {

                # remove command
                shift @input;

                # check and remove options
                my @options = get_command_possible_options($command);
                @ARGV = @input;
                if (   ( not @options )
                    || ( GetOptions( \%options_complete, @options ) ) )
                {

                    my @params = get_command_possible_params($command);
                    if ($verbose) { print "params: ", Dumper(@params); }

                    my $number_arguments = @input;

                    #print "input: ", join( ",", @input ), " (", $number_arguments, ")\n";

                    if ( $number_arguments > 0 ) {
                        my $parameter_number = $number_arguments - 1;
                        if ( defined( $params[$parameter_number] )
                            && $params[$parameter_number] )
                        {
                            my $param = $params[$parameter_number];
                            if ($verbose) {
                                print "param used: ", $param, "\n";
                            }
                            if ( $param eq "PATH_PROD" ) {
                                complete_path(
                                    $input[ $number_arguments - 1 ] );
                            } elsif ( $param eq "PATH_REPO" ) {
                                complete_repopath(
                                    $input[ $number_arguments - 1 ] );
                            }
                        }
                    }
                }
            }
        }
    }
}

sub complete_path(@)
{
    check_parameter( @_, 1 );
    check_env();

    (
        my $basename,
        my $dirname_prod,
        my $dirname_repo,
        my $filename_prod,
        my $filename_repo
    ) = get_filenames( $_[0] );

    my @files = get_complete_path_globbing($filename_prod);

    if (@files) {
        print join( "\n", @files );
        print "\n";
    }
}

sub complete_repopath(@)
{
    check_parameter( @_, 1 );
    check_env();

    (
        my $basename,
        my $dirname_prod,
        my $dirname_repo,
        my $filename_prod,
        my $filename_repo
    ) = get_filenames( $_[0] );

    my @files = get_complete_path_globbing($filename_repo);

    if (@files) {

        # remove DASSCM_REPO path again
        print join(
            "\n",
            map( {
                    s|^${DASSCM_REPO}|/|;
                      $_
                } @files )
        );
        print "\n";
    }

}

#####################################################################
#
# main
#

my $return_code      = $RETURN_OK;
my $number_arguments = @ARGV;

# global options
# stops at first non-option
Getopt::Long::Configure('require_order');
if ( not GetOptions( \%options, @OPTIONS_GLOBAL ) ) {
    usage();
    exit $RETURN_NOK;
}

# set verbose to command line option
$verbose = $options{'verbose'};

if ( $options{'help'} ) {
    help(@ARGV);
    exit;
}

# get subcommand and remove it from @ARGV
if ( defined( $ARGV[0] ) ) {
    $command = get_command_uniform_name( $ARGV[0] );
    shift @ARGV;
}

if ( not defined($command) ) {
    usage();
    exit $RETURN_NOK;
}

$DASSCM_LOCAL_REPOSITORY_BASE = $config->{'DASSCM_LOCAL_REPOSITORY_BASE'};
$DASSCM_REPOSITORY_NAME       = $config->{'DASSCM_REPOSITORY_NAME'};

# TODO: check variables
$DASSCM_SVN_REPOSITORY =
  $config->{'DASSCM_SVN_REPOSITORY_BASE'} . "/" . $DASSCM_REPOSITORY_NAME;

$DASSCM_CHECKOUT_USERNAME = $config->{'DASSCM_CHECKOUT_USERNAME'};
$DASSCM_CHECKOUT_PASSWORD = $config->{'DASSCM_CHECKOUT_PASSWORD'};

#
# if a user is given by dasscm configuration file, we use it.
# Otherwise we expect that read-only account is configured
# as local subversion configuration.
# If this is also not the case,
# user is required to type username and password.
# This will be stored as local subversion configuration thereafter.
#
if ( $DASSCM_CHECKOUT_USERNAME && $DASSCM_CHECKOUT_PASSWORD ) {
    $svnCheckoutCredentials =
      " --username $DASSCM_CHECKOUT_USERNAME --password $DASSCM_CHECKOUT_PASSWORD ";
}

$DASSCM_PERMISSION_FILE = $config->{'DASSCM_PERMISSION_FILE'}
  || "/etc/permissions.d/dasscm.permission_backup";

# check for command options
my @cmd_options = get_command_possible_options($command);
if (@cmd_options) {

    # get command line options and store them in options hash
    my $result = GetOptions( \%options, @cmd_options );

    # print options
    foreach my $option ( keys %options ) {
        print "${option}: $options{$option}\n";
    }
}

#
# action accordinly to command are taken
#
&{ get_command_function($command) }(@ARGV);

exit $return_code;