#!/usr/bin/env perl
##**************************************************************
##
## Copyright (C) 1990-2007, Condor Team, Computer Sciences Department,
## University of Wisconsin-Madison, WI.
## 
## Licensed under the Apache License, Version 2.0 (the "License"); you
## may not use this file except in compliance with the License.  You may
## obtain a copy of the License at
## 
##    http://www.apache.org/licenses/LICENSE-2.0
## 
## Unless required by applicable law or agreed to in writing, software
## distributed under the License is distributed on an "AS IS" BASIS,
## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
## See the License for the specific language governing permissions and
## limitations under the License.
##
##**************************************************************

#
# Globus Toolkit Public License (GTPL)
#     
# Copyright (c) 1999 University of Chicago and The University of 
# Southern California. All Rights Reserved.
# 
#  1) The "Software", below, refers to the Globus Toolkit (in either
#     source-code, or binary form and accompanying documentation) and a
#     "work based on the Software" means a work based on either the
#     Software, on part of the Software, or on any derivative work of
#     the Software under copyright law: that is, a work containing all
#     or a portion of the Software either verbatim or with
#     modifications.  Each licensee is addressed as "you" or "Licensee."
# 
#  2) The University of Southern California and the University of
#     Chicago as Operator of Argonne National Laboratory are copyright
#     holders in the Software.  The copyright holders and their third
#     party licensors hereby grant Licensee a royalty-free nonexclusive
#     license, subject to the limitations stated herein and
#     U.S. Government license rights.
# 
#  3) A copy or copies of the Software may be given to others, if you
#     meet the following conditions:
# 
#     a) Copies in source code must include the copyright notice and
#        this license.
# 
#     b) Copies in binary form must include the copyright notice and
#        this license in the documentation and/or other materials
#        provided with the copy.
# 
#  4) All advertising materials, journal articles and documentation
#     mentioning features derived from or use of the Software must
#     display the following acknowledgement:
# 
#     "This product includes software developed by and/or derived from
#     the Globus project (http://www.globus.org/)."
# 
#     In the event that the product being advertised includes an intact
#     Globus distribution (with copyright and license included) then
#     this clause is waived.
# 
#  5) You are encouraged to package modifications to the Software
#     separately, as patches to the Software.
# 
#  6) You may make modifications to the Software, however, if you
#     modify a copy or copies of the Software or any portion of it,
#     thus forming a work based on the Software, and give a copy or
#     copies of such work to others, either in source code or binary
#     form, you must meet the following conditions:
# 
#     a) The Software must carry prominent notices stating that you
#        changed specified portions of the Software.
# 
#     b) The Software must display the following acknowledgement:
# 
#        "This product includes software developed by and/or derived
#         from the Globus Project (http://www.globus.org/) to which the
#         U.S. Government retains certain rights."
# 
#  7) You may incorporate the Software or a modified version of the
#     Software into a commercial product, if you meet the following
#     conditions:
# 
#     a) The commercial product or accompanying documentation must
#        display the following acknowledgment:
# 
#        "This product includes software developed by and/or derived
#         from the Globus Project (http://www.globus.org/) to which the
#         U.S. Government retains a paid-up, nonexclusive, irrevocable
#         worldwide license to reproduce, prepare derivative works, and
#         perform publicly and display publicly."
# 
#     b) The user of the commercial product must be given the following
#        notice:
# 
#        "[Commercial product] was prepared, in part, as an account of
#         work sponsored by an agency of the United States Government.
#         Neither the United States, nor the University of Chicago, nor
#         University of Southern California, nor any contributors to
#         the Globus Project or Globus Toolkit nor any of their employees,
#         makes any warranty express or implied, or assumes any legal
#         liability or responsibility for the accuracy, completeness, or
#         usefulness of any information, apparatus, product, or process
#         disclosed, or represents that its use would not infringe
#         privately owned rights.
# 
#         IN NO EVENT WILL THE UNITED STATES, THE UNIVERSITY OF CHICAGO
#         OR THE UNIVERSITY OF SOUTHERN CALIFORNIA OR ANY CONTRIBUTORS
#         TO THE GLOBUS PROJECT OR GLOBUS TOOLKIT BE LIABLE FOR ANY
#         DAMAGES, INCLUDING DIRECT, INCIDENTAL, SPECIAL, OR CONSEQUENTIAL
#         DAMAGES RESULTING FROM EXERCISE OF THIS LICENSE AGREEMENT OR
#         THE USE OF THE [COMMERCIAL PRODUCT]."
# 
#  8) LICENSEE AGREES THAT THE EXPORT OF GOODS AND/OR TECHNICAL DATA
#     FROM THE UNITED STATES MAY REQUIRE SOME FORM OF EXPORT CONTROL
#     LICENSE FROM THE U.S. GOVERNMENT AND THAT FAILURE TO OBTAIN SUCH
#     EXPORT CONTROL LICENSE MAY RESULT IN CRIMINAL LIABILITY UNDER U.S.
#     LAWS.
# 
#  9) Portions of the Software resulted from work developed under a
#     U.S. Government contract and are subject to the following license:
#     the Government is granted for itself and others acting on its
#     behalf a paid-up, nonexclusive, irrevocable worldwide license in
#     this computer software to reproduce, prepare derivative works, and
#     perform publicly and display publicly.
# 
# 10) The Software was prepared, in part, as an account of work
#     sponsored by an agency of the United States Government.  Neither
#     the United States, nor the University of Chicago, nor The
#     University of Southern California, nor any contributors to the
#     Globus Project or Globus Toolkit, nor any of their employees,
#     makes any warranty express or implied, or assumes any legal
#     liability or responsibility for the accuracy, completeness, or
#     usefulness of any information, apparatus, product, or process
#     disclosed, or represents that its use would not infringe privately
#     owned rights.
# 
# 11) IN NO EVENT WILL THE UNITED STATES, THE UNIVERSITY OF CHICAGO OR
#     THE UNIVERSITY OF SOUTHERN CALIFORNIA OR ANY CONTRIBUTORS TO THE
#     GLOBUS PROJECT OR GLOBUS TOOLKIT BE LIABLE FOR ANY DAMAGES,
#     INCLUDING DIRECT, INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES
#     RESULTING FROM EXERCISE OF THIS LICENSE AGREEMENT OR THE USE OF
#     THE SOFTWARE.
# 
#                               END OF LICENSE
# 
#
package MyGridFTP;
require 5.005;			# don't use 5.x.y string
use strict;
use File::Spec;			# standard module
use File::Basename;		# standard module
use File::Temp qw(tempfile);	# 5.6.1 standard module
use Exporter;			# standard module

use lib dirname($0);
use MyCommon;
use MyGlobus qw($subject $userglobusdir $usercertfile $userkeyfile);

# declare prototypes before exporting them
use vars qw(@ISA @EXPORT @EXPORT_OK);
sub check_gridftp(\@);
sub junk_file(;$);

@ISA = qw(Exporter);
@EXPORT = qw(RunTests ListTests);
@EXPORT_OK = qw(junk_file);

sub junk_file (;$) {
    # purpose: create a junk file
    # paramtr: size (opt. IN): size of junk file, must be divisible by 4
    # returns: name of created junk file in scalar context, or
    #          [0] file name, [1], file size, [2] file MD5 in array context
    # onerror: returns undef in scalar context, or emptyvec in array context
    # warning: uses system md5sum executable, thus [2] may return undef
    my $size = shift || 1024*1024;
    my ($fh,$fn) = tempfile( 'fileXXXXXX', DIR => File::Spec->tmpdir,
			     SUFFIX => '.junk', UNLINK => 1 );
    return (wantarray ? () : undef) unless defined $fh;

    my $i = 0;
    while ( $i < $size ) {
	my $data = pack( "I2", rand(65536), rand(65536) ^ $$ );
	write( $fh, $data, 4 );
	$i += 4;
    }
    close($fh);

    # Why dont I use Digest::MD5? It's not part of standard perl!
    my $md5 = `md5sum -b $fn | cut -c -32 2>>/dev/null`;
    $md5 =~ s/\r*\n$//;
    return ( wantarray ? ( $fn, $i, ( $?==0 ? $md5 : undef ) ) : $fn );
}

sub InitTests( ) {
    ResultInit( "gridftp" );
}

sub RunTests (\@) {
    # purpose: do a gridftp check-up
    # paramtr: $server (IN): vector of gridftp servers
    # warning: $server is a vector ref, which will be modified. 
    # returns: true for ok, undef for error
    my $server = shift || return undef;	# must have servers list
    print ">> ", join("\n>> ",@$server),"\n" if $main::DEBUG;

    # Have we run already?
    if ( TestRan( "gridftp" ) ) {
	return 0;
    }

    # Skip?
    if ( ! TestEnabled( "gridftp" ) ) {
	return 0;
    }

    # Did the Globus run & pass?  If not, don't bother...
    my $GlobusRes = GetResult( "globus" );
    if ( ! TestRan( "globus" ) ) {
	if ( ! TestEnabled( "globus" ) ) {
	    $main::Done = 0;
	    return 0;
	}
	print "\nWARNING!\n";
	print "\nSkipping the Grid-FTP test because the Globus test was skipped\n\n";
	return 0;
    } elsif ( $GlobusRes->{Status} < 0 ) {
	print "\nSkipping the Grid-FTP test because the Globus test failed\n\n";
	return 0;
    }

    # Set the status name
    SetTestName( "gridftp" );
    SetTestRan( 1 );

    # local 2 local
    print "\nTrying to create a junk file\n";
    my @src = junk_file();
    if ( defined $src[0] ) {
	print "OK: created junk file $src[0]\n";
    } else {
	print "FAILURE!\n";
	print "Cannot create a 1MB junk file in your temporary directory. Without it\n";
	print "it is hard to check gridftp.\n";
	return Ret( -1, "Cannot create junk file" );
    }

    # create a destination file
    my @dst = reverse tempfile( 'fileXXXXXX', DIR => File::Spec->tmpdir,
				SUFFIX => '.junk', UNLINK => 1 );
    close($dst[1]);

    # and copy
    my @output = `globus-url-copy file:///$src[0] file:///$dst[0] 2>&1`;
    print "# ", join("\n# ",@output), "\n" if @output > 0;
    if ( @output == 0 && $? == 0 ) {
	print "OK: local to local copy.\n";
    } else {
	my $code = $? >> 8;
	print "FAILURE! exit code $code\n";
	print "I cannot copy from local to local. This is most puzzling. I believe that\n";
	print "your globus-url-copy may be broken.\n";
	return Ret( -1, "globus-url-copy broken" );
    }

    print "\nFIXME: I need to do a lot more gridftp tests, when time permits.\n";

    print "\nWell, I cannot really say a lot about your GridFTP.\n";
    wait_enter;

    # return the perl way
    return 0;
}

1;
