382 lines
11 KiB
Perl
Executable file
382 lines
11 KiB
Perl
Executable file
#!/usr/bin/perl -w
|
|
#
|
|
# Clone a new sysadmin package from this one.
|
|
#
|
|
|
|
use strict;
|
|
use Getopt::Long qw(:config permute); # allow mixed args.
|
|
use POSIX;
|
|
use File::Copy;
|
|
use FindBin qw($Bin);
|
|
BEGIN{ chdir("$Bin/..") }
|
|
|
|
# You may need libterm-readline-gnu-perl to be installed
|
|
use Term::ReadLine;
|
|
|
|
my $debug = 0;
|
|
my $helpmeplease = 0;
|
|
|
|
GetOptions ('debug!' => \$debug,
|
|
'help' => \$helpmeplease
|
|
);
|
|
|
|
show_usage() if ( $helpmeplease );
|
|
|
|
my $term = new Term::ReadLine 'clone-new-sysadmin';
|
|
if(not exists $INC{'Term/ReadLine/Gnu.pm'}) {
|
|
warn "You may wish to use Ctrl-C to interrupt this program and run the\n"
|
|
. "following command:\n\n\n"
|
|
. " apt-get install libterm-readline-gnu-perl\n\n";
|
|
}
|
|
my $diffs = `git diff-index HEAD 2>/dev/null`;
|
|
if ($? != 0) {
|
|
die "You need git-core installed to use this program.\n\n"
|
|
. "run:\n\n"
|
|
. " apt-get install git-core\n\n";
|
|
} elsif ($diffs) {
|
|
warn "Your checkout has uncommitted changes. These will be bundled\n"
|
|
."into the first commit of your branch.\n";
|
|
}
|
|
|
|
my ( $package_name, $organisation, $new_name, $full_name,
|
|
$user_names, $uid, $gid, $gecos, $junk, $email );
|
|
|
|
# Get the current package name
|
|
my @pwent = getpwuid($<);
|
|
$user_names = $pwent[0];
|
|
$uid = $pwent[2];
|
|
$gid = $pwent[3];
|
|
$gecos = $pwent[4];
|
|
( $full_name, $junk ) = split ",", $gecos ;
|
|
|
|
# Attempt to avoid UID/GID collisions
|
|
$uid = 2500 + int(rand(1500)) if ( $uid <= 1000 );
|
|
$gid = $uid if ( $gid <= 1000 );
|
|
|
|
my @components = split '/', POSIX::getcwd() ;
|
|
$package_name = pop @components;
|
|
$organisation = $package_name;
|
|
$organisation =~ s/-.*$// ;
|
|
$organisation = $term->readline( "Enter the name of the Organisation: ", $organisation );
|
|
|
|
$junk = $full_name;
|
|
$full_name = $term->readline( "Enter the full name of the target sysadmin: ", $full_name );
|
|
if ( $junk ne $full_name ) {
|
|
# Ok, they edited it. Let's try and invent a user name list
|
|
my @name_parts = split /\s+/, lc($full_name) ;
|
|
my $first = $name_parts[0];
|
|
my $last = $name_parts[-1];
|
|
my $initials = "";
|
|
foreach( @name_parts ) {
|
|
$initials .= substr($_, 0,1);
|
|
}
|
|
$user_names = "$first $first".substr($last,0,1)." $initials ".substr($first,0,1)."$last $first.$last ";
|
|
}
|
|
|
|
$new_name = lc( "$organisation-$full_name" );
|
|
$new_name =~ s/\s+\S+.*\s+//;
|
|
$new_name =~ s/ //g;
|
|
print <<EOT ;
|
|
|
|
|
|
The new name should be of the form "organisation-firstnamelastname"
|
|
so that people don't need to be told the name of the package, and
|
|
so we can easily see them grouped in the installed packages listing.
|
|
|
|
EOT
|
|
|
|
$new_name = $term->readline( "Enter the new name for the target package: ", $new_name );
|
|
$user_names = $term->readline( "Preferred usernames (space delimited): ", $user_names );
|
|
$uid = $term->readline( "Preferred UID: ", $uid );
|
|
$gid = $term->readline( "Preferred GID: ", $gid );
|
|
|
|
print <<EOT ;
|
|
|
|
This package can set a shell password (which in turn is used by sudo)
|
|
but requires a GPG key to encrypt to. The email address you provide
|
|
below will be used to locate a suitable public key in the current
|
|
user's keyring. It *can* also be used as the target of an encrypted
|
|
email.
|
|
|
|
The public key you specify here must be available in your default keyring
|
|
(specifically of the user executing this script).
|
|
|
|
Specify "none" to disable password generation and notification.
|
|
|
|
EOT
|
|
|
|
my $default_email = $organisation eq 'positiveinternet'
|
|
? $user_names . '@positive-internet.com'
|
|
: '';
|
|
$default_email =~ s{ (?:.* )?}{}; # remove alternate usernames
|
|
|
|
$email = $term->readline( "Email address to notify/encrypt to: ", $default_email );
|
|
|
|
$email ||= 'none';
|
|
|
|
my $suppress_email_notify = '';
|
|
|
|
if($email ne 'none') {
|
|
print <<EOT ;
|
|
|
|
Do you want an (encrypted) email notification whenever your package is
|
|
installed (if you answer 'no', an encrypted notification will still be
|
|
saved in your home directory but no email will be generated)?
|
|
|
|
EOT
|
|
|
|
my $want_email = $term->readline( "Always send password by email (y/N)? ", 'N');
|
|
if($want_email and $want_email =~ /^y/i) {
|
|
$suppress_email_notify = 'N';
|
|
}
|
|
}
|
|
|
|
printf( "Cloning from %s to %s for %s\n", $package_name, $new_name, $full_name );
|
|
print <<EOTXT ;
|
|
Attempting usernames: $user_names
|
|
Preferred UID/GID: $uid / $gid
|
|
EOTXT
|
|
|
|
|
|
my @exclude_files = (
|
|
'build',
|
|
'.git$',
|
|
'faces/',
|
|
'ssh-keys/(?!.placeholder)',
|
|
'gpg-keys/',
|
|
'preferred_fullname',
|
|
'preferred_names',
|
|
'preferred_uid',
|
|
'preferred_gid',
|
|
'notification_email',
|
|
'suppress_email_notify',
|
|
"debian\\/$package_name\\.",
|
|
'debian\\/tmp$',
|
|
'debian\\/files$',
|
|
'.*~',
|
|
);
|
|
|
|
# If we have a 'preferred_uid' file we won't copy skel
|
|
if ( -f 'preferred_uid' ) {
|
|
push @exclude_files, 'skel/';
|
|
}
|
|
|
|
############################################################
|
|
# copy_files
|
|
############################################################
|
|
my ($url) = map { m{URL: (.*)} ? ($1) : () } `git remote show origin`;
|
|
|
|
$url =~ s|http://(.*?)/|git+ssh://$1/git/private/|;
|
|
|
|
chdir '..';
|
|
system("git", "clone", "--bare", "-l", $package_name, "$new_name/.git") == 0
|
|
or die "git clone failed; rc=$?";
|
|
{
|
|
local($ENV{GIT_DIR})="$new_name/.git";
|
|
my $branch_name = "refs/heads/$new_name";
|
|
system("git", "update-ref", $branch_name, "HEAD");
|
|
system("git", "symbolic-ref", "HEAD", $branch_name);
|
|
system("git", "read-tree", "HEAD");
|
|
system("git", "config", "core.bare", 'false');
|
|
if ( $url ) {
|
|
(system("git", "remote", "add", "origin", $url) == 0)
|
|
or warn "upgrade your git to 1.5+\n";
|
|
system("git", "config", "remote.origin.fetch",
|
|
"+refs/heads/master:refs/heads/origin/master");
|
|
system("git", "config", "remote.origin.push",
|
|
"+$branch_name:$branch_name");
|
|
}
|
|
copy_files_carefully( $package_name, $new_name );
|
|
chdir $new_name;
|
|
}
|
|
|
|
|
|
############################################################
|
|
# customise_files
|
|
############################################################
|
|
my @files = ( 'changelog', 'control', 'README.debian',
|
|
'rules', 'templates', 'config',
|
|
'sysadmin.postinst', 'sysadmin.postrm',
|
|
'.gitignore'
|
|
);
|
|
foreach my $fn ( @files ) {
|
|
print "Customising $fn\n";
|
|
rename "debian/$fn", "debian/$fn.cloned";
|
|
open( OLD, "<", "debian/$fn.cloned" );
|
|
open( NEW, ">", "debian/$fn" );
|
|
while( <OLD> ) {
|
|
s/positiveinternet-userpackage/$new_name/;
|
|
s/$package_name/$new_name/;
|
|
s/__FULL_NAME__/$full_name/g;
|
|
print NEW $_;
|
|
}
|
|
close(NEW);
|
|
close(OLD);
|
|
unlink "debian/$fn.cloned";
|
|
}
|
|
|
|
############################################################
|
|
# dig out gpg key to use
|
|
############################################################
|
|
|
|
# For this, we need to run gpg and extract the public key
|
|
# then re-import it into a new keyring we put into the
|
|
# package. Hackish, but it'll do.
|
|
|
|
if ($email ne "none") {
|
|
system("gpg --export $email > notifyring.gpg");
|
|
if(-s 'notifyring.gpg' == 0) {
|
|
die "\nError: There is no key matching '$email' in yor GnuPG keyring\n"
|
|
. "Package not created.\n";
|
|
}
|
|
} else {
|
|
system("touch notifyring.gpg");
|
|
}
|
|
|
|
############################################################
|
|
# write_preferences
|
|
############################################################
|
|
write_preference( 'preferred_fullname', $full_name );
|
|
write_preference( 'preferred_names', $user_names );
|
|
write_preference( 'preferred_uid', $uid );
|
|
write_preference( 'preferred_gid', $gid );
|
|
write_preference( 'notification_email', $email );
|
|
write_preference( 'suppress_email_notify', $suppress_email_notify );
|
|
|
|
# Ensure appropriate things are marked executable
|
|
chmod 0755, 'debian/rules';
|
|
chmod 0755, 'bin/clone-new-sysadmin';
|
|
|
|
for my $dir ('ssh-keys', 'gpg-keys', 'skel') {
|
|
mkdir $dir unless -d $dir;
|
|
}
|
|
|
|
# check into git
|
|
my @rms = map { chomp; $_ }
|
|
`git diff-index --name-only --diff-filter=D HEAD`;
|
|
system("git", "add", ".");
|
|
system("git", "rm", @rms) if @rms;
|
|
system("git", "commit", "-m", "Cloned package for $full_name using $0");
|
|
|
|
############################################################
|
|
# We're done...
|
|
############################################################
|
|
my $newdir = join( '/', @components) . "/$new_name";
|
|
print <<EOTXT ;
|
|
|
|
OK, the new package framework has been created in:
|
|
|
|
$newdir
|
|
|
|
What you will need to do now, is to copy any keys into the
|
|
ssh-keys subdirectory and any gpg keys into the gpg-keys
|
|
subdirectory. After that you can make any other modifications
|
|
you would like. For a basic starting point it is probably
|
|
sufficient to:
|
|
|
|
cd $newdir
|
|
cp ~/.ssh/id*.pub ssh-keys
|
|
fakeroot ./debian/rules binary
|
|
|
|
To create a new version of the package, use "debchange -i" to
|
|
increment the revision number, and comment on what the change
|
|
is that is being made.
|
|
|
|
EOTXT
|
|
|
|
exit 0;
|
|
|
|
|
|
############################################################
|
|
# ONLY SUBROUTINES BELOW HERE
|
|
############################################################
|
|
|
|
|
|
############################################################
|
|
# customise_files - customises a set of files
|
|
# Files/lines to be changed
|
|
# debian/changelog
|
|
# debian/control
|
|
# debian/README.debian
|
|
# debian/rules
|
|
############################################################
|
|
|
|
sub write_preference {
|
|
my $filename = shift;
|
|
my $preference = shift;
|
|
|
|
open( PREF, ">", $filename );
|
|
print PREF $preference;
|
|
close(PREF);
|
|
}
|
|
|
|
############################################################
|
|
# Copy a tree of files carefully
|
|
############################################################
|
|
sub copy_files_carefully {
|
|
my $source = shift;
|
|
my $dest = shift;
|
|
|
|
return if (!defined($dest) || !defined($source) );
|
|
|
|
if ( ! -e $dest ) {
|
|
mkdir $dest;
|
|
}
|
|
print "Copying files in $source\n";
|
|
opendir( SDIR, $source ) or die("Can't open source directory: $!");
|
|
my @files = readdir(SDIR);
|
|
closedir( SDIR );
|
|
|
|
foreach my $fn ( @files ) {
|
|
next if ( $fn eq '.' || $fn eq '..' );
|
|
next if ( exclude_from_copy("$source/$fn") );
|
|
if ( -d "$source/$fn" ) {
|
|
# Recurse to copy the subdirectory
|
|
copy_files_carefully( "$source/$fn", "$dest/$fn" );
|
|
}
|
|
else {
|
|
print "Copying from $source/$fn to $dest/$fn\n" if ( $debug );
|
|
copy( "$source/$fn", "$dest/$fn" );
|
|
}
|
|
}
|
|
|
|
}
|
|
|
|
|
|
############################################################
|
|
# Decide whether this file should be exluded from the copy
|
|
############################################################
|
|
sub exclude_from_copy {
|
|
my $fn = shift;
|
|
|
|
foreach( @exclude_files ) {
|
|
if ( $fn =~ /^$package_name\/$_/ ) {
|
|
print "Excluding $fn\n" if ( $debug );
|
|
return 1;
|
|
}
|
|
}
|
|
|
|
# No match, so it must be OK then :-)
|
|
return 0;
|
|
}
|
|
|
|
############################################################
|
|
# Tell the nice user how we do things. Short and sweet.
|
|
############################################################
|
|
sub show_usage {
|
|
print <<OPTHELP;
|
|
|
|
bin/clone-new-sysadmin
|
|
|
|
There are no options - all variables are prompted for.
|
|
|
|
bin/clone-new-sysadmin will clone this package to a new sysadmin
|
|
package, prompting for important information and telling you what
|
|
to do next. It needs to be run from the base source directory
|
|
of an existing package.
|
|
|
|
OPTHELP
|
|
exit 0;
|
|
}
|
|
|
|
|