source: trunk/dasscm/dasscm@ 237

#!/usr/bin/perl -w

# $Id: dasscm 237 2008-10-08 18:49:03Z 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;
use File::Copy;
use File::Find;
use File::stat;
use File::Path;
use Term::ReadKey;
#use Data::Dumper;

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

# file to store permissions
my $permissions_file = "/etc/permissions.d/dasscm.permission_backup";

# configuration file
my $config_file = "/etc/dasscm.conf";
my $config      = get_config($config_file);
my $DASSCM_LOCAL_REPOSITORY_BASE;
my $DASSCM_REPOSITORY_NAME;
my $DASSCM_SVN_REPOSITORY;

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

# 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 "usage: dasscm <subcommand> [options] [args]\n";
    print "\n";
    print "dasscm is intended to help versioning configuration files\n";
    print "\n";
    print "Available subcommands:\n";
    print "   help <subcommand>\n";
    print "   init\n";
    print "   login\n";
    print "   up\n";
    print "   ls\n";
    print "   add <filename>\n";
    print "   commit <filename>\n";
    print "   diff <filename>\n";
    print "   status\n";
    print "   permissions\n";
    print "\n";
    print "preperation:\n", "  if dasscm is already configured,\n",
      "  use 'dasscm login' and then eg. 'add'.\n",
      "  The environment variables\n", "    DASSCM_REPO\n", "    DASSCM_PROD\n",
      "    DASSCM_USERNAME\n", "    DASSCM_PASSWORD\n",
      "  are evaluated, but set automatically by 'dasscm login'.\n", "\n",
      "  If dasscm is not yet configured, read",
      "  /usr/share/doc/packages/dasscm/dasscm_howto.txt\n";
}

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

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

sub fatalerror(@)
{
    error( @_ );
    #print "Exiting\n";
    exit 1
}

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


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";
        }
    }
    if ($verbose) { print "DASSCM_REPO: " . $DASSCM_REPO . "\n"; }

    #
    # 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 ( $command ne "login" ) ) {
                die
                  "Envirnonment variable DASSCM_USERNAME not set.\nSet DASSCM_USERNAME to your subversion user account.\n";
            }
            $svnOptions .= " --no-auth-cache ";
        } elsif ( !$DASSCM_USERNAME ) {
            $DASSCM_USERNAME = $USER;
        }

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

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

sub check_parameter(@)
{
    if( not @_ ) {
        fatalerror( "no files specified. See 'dasscm --help'" );
    }
}

sub get_filenames(@)
{
    my $filename_prod = $_[0];

    # remove leading './' from relative directories
    #$filename_prod =~ s/^\.\///;

    if ( !( $filename_prod =~ m/^\// ) ) {
        $filename_prod = cwd() . "/" . $filename_prod;
    }

    if( not -r $filename_prod ) {
        fatalerror( $filename_prod  . " is not accessable" );
    }
    #      elsif( -l $filename_prod ) {
    #         my $dest = readlink($filename_prod);
    #         # TODO:
    #         #   default: disallow, but offer cmd switch to activate
    #         #   (or check, if file is already checked in and has been a link before)
    #         warning( "'$filename_prod' is a link to '$dest'.", "Please check, if '$dest' should be stored in repository instead" );
    #         if( ! -f $dest ) {
    #             fatalerror( "link target '$dest' is not a regular file. Giving up" );
    #         }
    #     } elsif( ! -f $filename_prod ) {
    #         #fatalerror( $filename_prod . " is not a regular file" );
    #     }

    # TODO: dirname buggy: eg. "/etc/" is reduced to "/",
    #   "/etc" is used as filename
    my $dirname_prod = dirname($filename_prod);
    my $oldpath = cwd();
    chdir $dirname_prod or die $!;
    $dirname_prod = cwd();
    chdir $oldpath;
    my $basename = basename($filename_prod);

    if ($verbose) {
        print "dir: " . $dirname_prod . "\n";
        print "fn: " . $basename . "\n";
    }

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

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

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 $uid        = $info->uid;
            my $uidname    = getpwuid($uid);
            my $gid        = $info->gid;
            my $gidname    = getgrgid($gid);
            push(
                @permlist,
                sprintf( "%-55s %-17s %4d",
                    $file, "${uidname}:${gidname}", $modestring )
            );
        } else {
            print "failed to get status of $file. It exists in the repository, but not on the system\n";
        }
    }
    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;

    print "checking credentials ... ";

    # 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, my @result ) =
      run_command(
        "$SVN ls --non-interactive --no-auth-cache --username $username --password $password $DASSCM_SVN_REPOSITORY"
      );

    if ( $rc_update != 0 ) {
        print @result;
        die;
    }

}

sub svn_update( ;$ )
{
    my $update_path = shift || $DASSCM_REPO;
    ( my $rc_update, my @result ) =
      run_command(
        "$SVN update --non-interactive $svnCheckoutCredentials $update_path");
    print @result;
    if ( $rc_update != 0 ) {
        die;
    }
}

sub svn_getStoredFiles( ;$ )
{

    # TODO: get_filenames?
    #my $rel_path = shift || "";
    #my $path = "${DASSCM_REPO}/${rel_path}";
    my $path = ${DASSCM_REPO};

    # svn ls -R is better, but much, much slower
    # ( my $rc, my @result ) = run_command("$SVN ls --recursive $svnCheckoutCredentials $path");
    ( my $rc, my @result ) =
      run_command(
        "cd $path && find | grep -v '/.svn' | sed -e 's/\.\\///' | grep -v '^\$'"
      );
    if ( $rc != 0 ) {
        print @result;
        die;
    }
    chomp(@result);
    return @result;
}


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 $_ ) {
                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
     };
}



#####################################################################
#
# functions

sub help(;@)
{
    if ( @_ == 0 ) {
        usage();
    } else {
        print "help for @_: ...\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);
    }

    # hidden password input
    print "Enter DASSCM user password: ";
    ReadMode('noecho');
    my $input_password = <STDIN>;
    ReadMode('normal');
    chomp($input_password);
    print "\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", "[dasscm shell]\n\n";

    my $shell = $SHELL || "bash";
    exec($shell) or die "failed to start new shell";
}

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; touch $permissions_file"
      );
}

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

    my @files = svn_getStoredFiles(@_);

    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] );

    if ( $command eq "add" ) {
        mkpath($dirname_repo);
    }

    copy( $filename_prod, $filename_repo ) or error "failed to copy $filename_prod to repository: $!";

    if ( $command eq "add" ) {

        my $oldpath = cwd();
        # 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($oldpath);
    }
}


#
# add (is used for command add and commit)
#
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";
    }

    if( @links ) {
        my $number = $#links + 1;
        print "\n";
        print "ignoring links ($number):\n";
        print join( "\n", @links );
        print "\n";
    }

    # 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($permissions_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"
      );

    #print $filename_prod. "\n";
    #print $dirname_repo. "\n";
}

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";

    ( my $rc_update, my @result ) = run_command("$SVN update $filename_repo");
    if ( $rc_update != 0 ) {
        print @result;
        die;
    }

    ( my $rc_diff, my @diff ) =
      run_command( $DIFF . " $filename_repo $filename_prod");
    print @diff;
}

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

    #
    # update local repository
    #
    svn_update();

    # TODO: start at subdirectories ?
    my $dir   = $DASSCM_REPO;
    my @files = svn_getStoredFiles($dir);

    # Liste der geänderten Files ausgeben, falls nicht leer
    if (@files) {

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

        foreach my $file (@files) {

            my $realfile    = "/" . $file;
            my $cvsworkfile = "${DASSCM_REPO}/${file}";

            if ( -d $realfile ) {

                # directory. do nothing
            } elsif ( !-r $realfile ) {
                $removedfiles{"$realfile"} = $cvsworkfile;
            } else {
                ( -r "$cvsworkfile" )
                  || die("Fehler: $cvsworkfile ist nicht lesbar");
                if ( compare( $cvsworkfile, $realfile ) != 0 ) {
                    $changedfiles{"$realfile"} = $cvsworkfile;
                }
            }
        }

        if (%removedfiles) {
            print "deleted files (found in repository, but not in system):\n";
            foreach my $key ( values %removedfiles ) {
                print "$key\n";
            }
            print "\n";
        }

        if (%changedfiles) {
            print "modified files:\n";
            foreach my $key ( keys %changedfiles ) {
                print "$key\n";
            }
        }
    } else {
        print "no modified files found in $dir\n";
    }

    print "\n";
}

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

    #
    # update local repository
    #
    #svn_update();

    # TODO: start at subdirectories ?
    my $dir   = $DASSCM_REPO;
    my @files = svn_getStoredFiles($dir);

    if (@files) {

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

        if ( -w dirname($permissions_file) ) {

            # Verzeichnis existiert => schreiben
            print "storing permissions in file $permissions_file\n";
            open( OUTFILE, ">$permissions_file" )
              || die("failed to write to $permissions_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";
        } else {

            # Pfad für Sicherungsdatei existiert nicht => schreiben auf stdout
            # Alias Filehandle für stdout erzeugen
            *OUTFILE = *STDOUT;
        }
        foreach my $line (@permissions) {
            print OUTFILE "$line\n";
        }

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

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

my $number_arguments = @ARGV;

if ( $number_arguments > 0 ) {

    # get subcommand and remove it from @ARGV
    $command = $ARGV[0];
    shift @ARGV;

    $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;

    my $DASSCM_CHECKOUT_USERNAME = $config->{'DASSCM_CHECKOUT_USERNAME'};
    my $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 ";
    }

    # get command line options and store them in options hash
    my $result = GetOptions( \%options, 'verbose', 'message=s' );

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

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

    #
    # action accordinly to command are taken
    # $command is rewritten in standard format,
    # so we can test for it later on more simply
    #
    $_ = $command;
    if (m/help/i) {
        help(@ARGV);
    } elsif (m/login/i) {
        $command = "login";
        login(@ARGV);
    } elsif (m/init/i) {
        $command = "init";
        init(@ARGV);
    } elsif (m/ls/i) {
        $command = "ls";
        ls(@ARGV);
    } elsif ( (m/update/i) || (m/up/i) ) {
        $command = "update";
        update(@ARGV);
    } elsif (m/add/i) {
        $command = "add";
        add(@ARGV);
    } elsif (m/commit/i) {
        $command = "commit";
        add(@ARGV);
    } elsif (m/blame/i) {
        $command = "blame";
        blame(@ARGV);
    } elsif (m/diff/i) {
        $command = "diff";
        diff(@ARGV);
    } elsif ( (m/status/i) || (m/st/i) ) {
        $command = "status";
        status(@ARGV);
    } elsif (m/permissions/i) {
        $command = "permissions";
        permissions(@ARGV);
    } else {
        print "unknown command: $command\n\n";
        usage();
        check_env();
    }

    # cleanup (svn-commit.tmp)
    # commitall
    # revert
    # activate
    # rm
}