Annotation of /ccfdev/packages/devel/lib/uploadccf

#! /usr/bin/env perl
#
#  uploadccf

use strict;
use lib ("$ENV{'HOME'}/perl/");
use Net::FTP;
use File::Copy;
use Mail::Send;
use FileHandle;
use File::Path;

require 5.005;

my $VERSION = "2.6";

use Getopt::Long;

#=head1 NAME
#
#uploadccf - 
#
#=head1 SYNOPSIS
#
#uploadccf [--clobber] [--fpt] package ...
#
#=head1 DESCRIPTION
#
#Upload CCF packages to the server. If a package already exists on the server
#it will not be uploaded again unless the --clobber option is given.
#
#With the --ftp option uploadccf tries to use the ftp upload
#area. Normally it makes use of the copy command.
#
#=head1 EXAMPLES
#
#=over 4
#
#=item *
#
#Submit packages foo-1.2.tgz and bar-2.4.tgz
#
#C<uploadccf foo-1.2.tgz bar-2.4.tgz>
#
#=back
#
#=head1 AUTHOR
#
# ESA (c) 2000
#
#=cut


# Configure these for the remote FTP server:
#
# Despite these definitions, this is not used anymore
# because updated or new packages are deposited in the
# subdirectory incoming of the CCFLIB_HOME in the intranet
# So regardless of what we set in the command line with --ftp
# the doftp is always set to false.
#
my $server        = "sasdev-xmm.esac.esa.int";
my $remote_dir    = "/pub/ccf/private/incoming/";
my $user          = "anonymous";
my $ccflib = 'ccf@sciops.esa.int';

## Variables for the upload to disk via Copy
my $ccflib_home   = $ENV{CCFLIB_HOME};
die "CCFLIB_HOME undefined.\n" if not ( $ccflib_home );

my $host = $ENV{HOSTNAME};

# The variable $uploadir is defined now as a subdirectory of 
# ccflib_home
my $uploaddir     = "$ccflib_home/incoming";

# Get program name
my $progname = $0;
$progname =~ s/.*\///;

my $clobber = 0;
my $doftp;

my $result = GetOptions("clobber+" => \$clobber,
                        'ftp' => \$doftp);

# doftp is always set to false regardless of the switch --ftp is present or not
#
#
# $doftp = 0;

# Process each ".tgz" file in turn
my @flist;

foreach(@ARGV){
    if(/-v/){
        print "$progname - $VERSION\n";
        exit(0);
    }
    if(-r){
        if(! /.+\.tgz/){
            warn("$_ is not a package and it'll be ignored.\n");
            next;
        }
        push @flist, $_;
    } else {
        warn("$_ cannot be read.\n");
    }
}

die "No files to transfer.\n" unless @flist;

my @oklist;

if($doftp){

        # This will not be executed anymore because regardless of switch --ftp
        # doftp is always set to "0" which is false.

        my $ftp = Net::FTP->new("$server") or die "Cannot connect to $server: $!\n";
        $ftp->login($user) or die "Cannot login as $user: $!\n";
        $ftp->binary();
        $ftp->cwd($remote_dir) or die "Cannot change directory to $remote_dir: $!\n";
  
        foreach my $pkgpath (@flist){
                my $pkg = $pkgpath;
                $pkg =~ s!^.+/!!;
                my @there = $ftp->dir() or die("Cannot list what packages are on the ftp server: $!\n");
                if(grep /$pkg/, @there and not $clobber){
                        warn("$pkg already exists on the server. Your local copy will not be uploaded\n");
                } else {
                        $ftp->put($pkgpath) ? push @oklist, $pkg : warn("Could not tranfer $pkg: $!\n");
                }
        }
} else {
  
        ##  chdir($uploaddir) or die("Cannot chdir to $uploaddir: $!\n");
        die("I cannot write to $uploaddir\n") if(not -W $uploaddir);
        foreach my $pkgpath (@flist){
                my $pkg = $pkgpath;
                $pkg =~ s!^.+/!!;
                if(-e "$uploaddir/$pkg"){
                        warn("$pkg already exists on the server. Your local copy will not be uploaded\n");
                } else {
                        copy($pkgpath, $uploaddir) ? push @oklist, $pkg : warn("Could not tranfer $pkg: $!\n");
                }
        }
}

if(@oklist){

        my $msg = Mail::Send    ->      new(
                                                Subject => "CCF package upload: @oklist",
                                                To      => $ccflib,
                                        );

        my $fh = $msg->open('sendmail');
        #
        # It has no sense anymore to say the files have been "uploaded" to $server
        # Instead we will say they have been deposited in $uploaddir in $host

        print $fh "\nThe following files were put in $uploaddir at $host: \n";

        foreach (@oklist) {
                
                print $fh "  $_\n";
                #print     "  $_\n";
                
                chdir($uploaddir) or die("Cannot chdir to $uploaddir: $!\n");
                my $tmp = "tmp"."$_";
                mkdir $tmp, 0777  or die "Could not create directory $tmp\n";
                chdir $tmp or die("Cannot chdir to $tmp: $!\n");
                my $x = qx(tar xzf ../$_);
                if($x != 0){
                        my $status = $x >> 8;
                        print STDERR "$_: tar file incomplete ($status). Still uploading?\n";
                        next;
                }
                my $ls = qx(ls -1);
                chomp($ls);
                my $cl = new FileHandle "$ls/ChangeLog", "r" or die("Do not see $ls/ChangeLog");
                my $inlog;
                while(<$cl>){
                        if(/^Version/){
                                if(not defined $inlog){
                                        $inlog++;
                                } else {
                                        last;
                                }
                        }
                        
                        #print "(1) $_\n" if(defined $inlog);
                        print $fh $_ if(defined $inlog);

                }
                $cl->close();
                #print "(2) closed ChangeLog\n";
                qx(chmod -R a+w *);
                chdir "..";
                #print "(3) chdir back to incoming\n";
                rmtree($tmp);
                #print "(4) rm tree tmp...\n";
        }
        #print "(5) finished foreach oklist\n";  

        $fh->close or die "couldn't send the message: $!\n";
       
        #print "(7) closed Mail message and sent\n";

        print "Notification message sent to $ccflib\n";
} else {
        print "No package was uploaded.\n";
}
1	ccflib	1.17	#! /usr/bin/env perl
2	gvacanti	1.1	#
3			# uploadccf
4
5	gvacanti	1.5	use strict;
6	ccflib	1.9	use lib ("$ENV{'HOME'}/perl/");
7	ccflib	1.8	use Net::FTP;
8	ccflib	1.9	use File::Copy;
9	ccflib	1.8	use Mail::Send;
10	ccflib	1.10	use FileHandle;
11			use File::Path;
12	gvacanti	1.1
13	ccflib	1.9	require 5.005;
14	gvacanti	1.1
15	ccflib	1.17	my $VERSION = "2.6";
16	gvacanti	1.1
17			use Getopt::Long;
18
19	ccflib	1.13	#=head1 NAME
20			#
21			#uploadccf -
22			#
23			#=head1 SYNOPSIS
24			#
25			#uploadccf [--clobber] [--fpt] package ...
26			#
27			#=head1 DESCRIPTION
28			#
29			#Upload CCF packages to the server. If a package already exists on the server
30			#it will not be uploaded again unless the --clobber option is given.
31			#
32			#With the --ftp option uploadccf tries to use the ftp upload
33			#area. Normally it makes use of the copy command.
34			#
35			#=head1 EXAMPLES
36			#
37			#=over 4
38			#
39			#=item *
40			#
41			#Submit packages foo-1.2.tgz and bar-2.4.tgz
42			#
43			#C<uploadccf foo-1.2.tgz bar-2.4.tgz>
44			#
45			#=back
46			#
47			#=head1 AUTHOR
48			#
49	ccflib	1.17	# ESA (c) 2000
50	ccflib	1.13	#
51			#=cut
52	gvacanti	1.1
53
54			# Configure these for the remote FTP server:
55	ccflib	1.14	#
56			# Despite these definitions, this is not used anymore
57			# because updated or new packages are deposited in the
58			# subdirectory incoming of the CCFLIB_HOME in the intranet
59			# So regardless of what we set in the command line with --ftp
60			# the doftp is always set to false.
61			#
62	ccflib	1.15	my $server = "sasdev-xmm.esac.esa.int";
63	ccflib	1.7	my $remote_dir = "/pub/ccf/private/incoming/";
64	gvacanti	1.5	my $user = "anonymous";
65	ccflib	1.16	my $ccflib = 'ccf@sciops.esa.int';
66	gvacanti	1.1
67	ccflib	1.9	## Variables for the upload to disk via Copy
68	ccflib	1.12	my $ccflib_home = $ENV{CCFLIB_HOME};
69			die "CCFLIB_HOME undefined.\n" if not ( $ccflib_home );
70	ccflib	1.14
71			my $host = $ENV{HOSTNAME};
72
73			# The variable $uploadir is defined now as a subdirectory of
74			# ccflib_home
75	ccflib	1.12	my $uploaddir = "$ccflib_home/incoming";
76	ccflib	1.9
77	gvacanti	1.1	# Get program name
78	gvacanti	1.5	my $progname = $0;
79	gvacanti	1.1	$progname =~ s/.*\///;
80
81	gvacanti	1.5	my $clobber = 0;
82	ccflib	1.9	my $doftp;
83	gvacanti	1.5
84	ccflib	1.9	my $result = GetOptions("clobber+" => \$clobber,
85			'ftp' => \$doftp);
86	gvacanti	1.5
87	ccflib	1.14	# doftp is always set to false regardless of the switch --ftp is present or not
88			#
89			#
90			# $doftp = 0;
91
92	gvacanti	1.1	# Process each ".tgz" file in turn
93			my @flist;
94
95			foreach(@ARGV){
96			if(/-v/){
97			print "$progname - $VERSION\n";
98			exit(0);
99			}
100			if(-r){
101			if(! /.+\.tgz/){
102			warn("$_ is not a package and it'll be ignored.\n");
103			next;
104			}
105			push @flist, $_;
106			} else {
107			warn("$_ cannot be read.\n");
108			}
109			}
110
111			die "No files to transfer.\n" unless @flist;
112
113			my @oklist;
114
115	ccflib	1.9	if($doftp){
116
117	ccflib	1.14	# This will not be executed anymore because regardless of switch --ftp
118			# doftp is always set to "0" which is false.
119
120	ccflib	1.13	my $ftp = Net::FTP->new("$server") or die "Cannot connect to $server: $!\n";
121			$ftp->login($user) or die "Cannot login as $user: $!\n";
122			$ftp->binary();
123			$ftp->cwd($remote_dir) or die "Cannot change directory to $remote_dir: $!\n";
124	ccflib	1.9
125	ccflib	1.13	foreach my $pkgpath (@flist){
126			my $pkg = $pkgpath;
127			$pkg =~ s!^.+/!!;
128			my @there = $ftp->dir() or die("Cannot list what packages are on the ftp server: $!\n");
129			if(grep /$pkg/, @there and not $clobber){
130			warn("$pkg already exists on the server. Your local copy will not be uploaded\n");
131			} else {
132			$ftp->put($pkgpath) ? push @oklist, $pkg : warn("Could not tranfer $pkg: $!\n");
133			}
134			}
135	ccflib	1.9	} else {
136
137	ccflib	1.13	## chdir($uploaddir) or die("Cannot chdir to $uploaddir: $!\n");
138			die("I cannot write to $uploaddir\n") if(not -W $uploaddir);
139			foreach my $pkgpath (@flist){
140			my $pkg = $pkgpath;
141			$pkg =~ s!^.+/!!;
142			if(-e "$uploaddir/$pkg"){
143			warn("$pkg already exists on the server. Your local copy will not be uploaded\n");
144			} else {
145			copy($pkgpath, $uploaddir) ? push @oklist, $pkg : warn("Could not tranfer $pkg: $!\n");
146			}
147			}
148	gvacanti	1.3	}
149
150	gvacanti	1.5	if(@oklist){
151	ccflib	1.13
152			my $msg = Mail::Send -> new(
153			Subject => "CCF package upload: @oklist",
154			To => $ccflib,
155			);
156
157			my $fh = $msg->open('sendmail');
158	ccflib	1.14	#
159			# It has no sense anymore to say the files have been "uploaded" to $server
160			# Instead we will say they have been deposited in $uploaddir in $host
161
162			print $fh "\nThe following files were put in $uploaddir at $host: \n";
163	ccflib	1.13
164			foreach (@oklist) {
165
166			print $fh " $_\n";
167			#print " $_\n";
168
169			chdir($uploaddir) or die("Cannot chdir to $uploaddir: $!\n");
170			my $tmp = "tmp"."$_";
171			mkdir $tmp, 0777 or die "Could not create directory $tmp\n";
172			chdir $tmp or die("Cannot chdir to $tmp: $!\n");
173			my $x = qx(tar xzf ../$_);
174			if($x != 0){
175			my $status = $x >> 8;
176			print STDERR "$_: tar file incomplete ($status). Still uploading?\n";
177			next;
178			}
179			my $ls = qx(ls -1);
180			chomp($ls);
181			my $cl = new FileHandle "$ls/ChangeLog", "r" or die("Do not see $ls/ChangeLog");
182			my $inlog;
183			while(<$cl>){
184			if(/^Version/){
185			if(not defined $inlog){
186			$inlog++;
187			} else {
188			last;
189			}
190			}
191
192			#print "(1) $_\n" if(defined $inlog);
193			print $fh $_ if(defined $inlog);
194
195			}
196			$cl->close();
197			#print "(2) closed ChangeLog\n";
198			qx(chmod -R a+w *);
199			chdir "..";
200			#print "(3) chdir back to incoming\n";
201			rmtree($tmp);
202			#print "(4) rm tree tmp...\n";
203			}
204			#print "(5) finished foreach oklist\n";
205
206			$fh->close or die "couldn't send the message: $!\n";
207
208			#print "(7) closed Mail message and sent\n";
209
210			print "Notification message sent to $ccflib\n";
211	gvacanti	1.5	} else {
212	ccflib	1.13	print "No package was uploaded.\n";
213	gvacanti	1.1	}