#!/usr/bin/perl -Tw
# $Id: ybc,v 1.1 2003/09/24 18:28:19 ken Exp $
# Ken Neighbors, Ph.D.

BEGIN {
    $ENV{PATH} = '/usr/local/bin:/usr/bin:/bin'; # Use untainted PATH.
    delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; # Make %ENV safer
}

################################################################################
use strict;
require Getopt::ArgvFile;
require Getopt::Long;
require Pod::Usage;
require IO::File;
require HTTP::Cookies;
require WWW::Yahoo::Briefcase;
require WWW::Yahoo::Credentials;

my %month;
@month{ 0 .. 11 } = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );

$0 =~ m!(.*)!; my $pod = $1; # save untainted location of script for pod2usage
$0 = "$0"; # Hide arguments from "ps" (including password if specified).

################################################################################
{
    my $options = parse_args();
    read_credentials( $options );
    init_ssl( $options );
    my $ybc = signin( $options );
    perform_command( $ybc, $options );
    warn "INFO: Done\n" if $options->{debug};
}

################################################################################
sub parse_args {

    # Load options from option file ~/.ybc.
    Getopt::ArgvFile::argvFile( home => 1 );

    # Restore arguments to "ps", but obscure password with asterisks.
    # Note: this has to be done after argvFile because that function
    # needs the original value for $0.
    my $args = " @ARGV";
    $args =~ s!(\s-)(p|-password)([\s=])([^\s]*)!"$1$2$3" . '*' x length($4)!e;
    $0 = "$0$args";

    # Parse options.
    my( $verbosity, $password );
    my $options = { verbose => sub { $verbosity = 1 },
		    quiet => sub { $verbosity = 0 },
		    debug => sub { $verbosity = $_[1] },
		    password => sub { $password = $_[1] },
		    password_fd => sub { $password = [$_[1]] },
		    prompt => sub { $password = {} },
		  };
    my $option_parser =
      Getopt::Long::Parser->new( config => [ 'bundling', 'no_debug' ] );
    $option_parser->getoptions( $options, 'help|h|?', 'man',
				'quiet|q', 'verbose|v', 'debug|d=i',
				'userid|u=s', 'password|p=s', 'password-fd=i',
				'prompt', 'ssl-ca-path=s', 'ssl-ca-file=s',
				'overwrite|o!', 'overwrite-prefix=s',
				'maxsize|max-size=i',
				'cookies=s', 'credentials=s' )
      or Pod::Usage::pod2usage( -input => $pod, -verbose => 0 );
    delete @{$options}{ qw( verbose quiet debug password password_fd prompt ) };
    $options->{debug} = $verbosity if defined $verbosity;
    if ( UNIVERSAL::isa( $password, 'HASH' ) ) {
	$options->{prompt} = 1;
    }
    elsif ( UNIVERSAL::isa( $password, 'ARRAY' ) ) {
	$options->{password_fd} = $password->[0];
    }
    elsif ( defined $password ) {
	$options->{password} = $password;
    }
    if ( defined $options->{'overwrite-prefix'} ) {
	my $prefix = $options->{'overwrite-prefix'};
	$prefix .= '-' unless substr( $prefix, -1 ) eq '-';
	$options->{overwrite} = $prefix;
	delete $options->{'overwrite-prefix'};
    }

    # Print help message if user requested it.
    Pod::Usage::pod2usage( -input => $pod, -verbose => 1 ) if $options->{help};
    Pod::Usage::pod2usage( -input => $pod, -verbose => 2 ) if $options->{man};

    # Check for valid command.
    $options->{command} = shift @ARGV;
    unless ( defined $options->{command} ) {
	Pod::Usage::pod2usage( -input => $pod, -exitval => 2,
			       -message => "command not specified" );
    }
    unless ( grep { $options->{command} eq $_ } WWW::Yahoo::Briefcase->do ) {
	Pod::Usage::pod2usage( -input => $pod, -exitval => 2, -message =>
			       "invalid command: $options->{command}" );
    }

    # Check for additional arguments.
    $options->{args} = [ @ARGV ] if @ARGV;

    $options;
}

################################################################################
sub read_credentials {
    my $options = shift;

    if ( defined $options->{password_fd} ) {
	# Read password from file descriptor number.
	my $fh = IO::File->open( "<&=$options->{password_fd}" )
	  or die "ERROR: could not open file descriptor number" .
	    " $options->{password_fd}: $!";
	$options->{password} = $fh->getline or die "ERROR: could not read" .
	  " password from file descriptor number $options->{password_fd}: $!";
	chomp $options->{password};
	$fh->close or die "ERROR: could not close file descriptor number" .
	  " $options->{password_fd}: $!";
    }

    my $credentials =
      WWW::Yahoo::Credentials::File->new( file => $options->{credentials},
					  subdir => '.yahoo',
					  filename => 'credentials.xml' );
    if ( not $options->{prompt} and -e $credentials
	 and ( not defined $options->{userid}
	       or not defined $options->{password} ) )
    {
	warn "INFO: Reading credentials from \"$credentials\"\n"
	  if $options->{debug};
	eval { $credentials = WWW::Yahoo::Credentials->new( $credentials ) };
	die "ERROR: $@" if $@;
	my( $userid, $password ) = $credentials->tuple( $options->{userid} );
	$options->{userid} = $userid unless defined $options->{userid};
	$options->{password} = $password unless defined $options->{password};
    }

    if ( $options->{prompt} or not defined $options->{userid}
	 or not defined $options->{password} )
    {
	require IO::Handle;
	IO::Handle::autoflush( \*STDOUT, 1 );
	print "Yahoo userid: ";
	$options->{userid} = <STDIN>;
	chomp $options->{userid};
	require POSIX;
	my $fn = fileno( \*STDIN );
	my $termios = new POSIX::Termios;
	$termios->getattr()
	  or die "ERROR: could not get terminal attributes for STDIN";
	my $c_lflag = $termios->getlflag;
	$termios->setlflag( $c_lflag & (~&POSIX::ECHO) ); # turn off echo
	$termios->setattr( $fn, &POSIX::TCSANOW )
	  or die "ERROR: could not set terminal attributes for STDIN";
	print "Password: ";
	$options->{password} = <STDIN>;
	chomp $options->{password};
	print "\n";
	$termios->setlflag( $c_lflag ); # restore original setting
	$termios->setattr( $fn, &POSIX::TCSANOW )
	  or die "ERROR: could not set terminal attributes for STDIN";
    }
}

################################################################################
sub init_ssl {
    my $options = shift;

    return unless exists $options->{'ssl-ca-file'}
      or exists $options->{'ssl-ca-path'};

    require Net::SSLeay;
    require IO::Socket::SSL;

    my $ssl_ca_path = '';
    if ( defined $options->{'ssl-ca-path'} ) {
	my $error;
	$error = 'does not exist' unless -e $options->{'ssl-ca-path'};
	$error = 'not a directory' unless -d _;
	$error = 'not readable' unless -r _;
	die "ERROR: ssl-ca-path $error: \"$options->{'ssl-ca-path'}\""
	  if $error;
	$ssl_ca_path = $options->{'ssl-ca-path'};
    }

    my $ssl_ca_file = '';
    if ( defined $options->{'ssl-ca-file'} ) {
	my $error;
	$error = 'does not exist' unless -e $options->{'ssl-ca-file'};
	$error = 'not a file' unless -f _;
	$error = 'not readable' unless -r _;
	die "ERROR: ssl-ca-file $error: \"$options->{'ssl-ca-file'}\""
	  if $error;
	$ssl_ca_file = $options->{'ssl-ca-file'};
    }

    my $ssl_verify_mode = &Net::SSLeay::VERIFY_PEER();
    IO::Socket::SSL::context_init(
				  SSL_ca_file => $ssl_ca_file,
				  SSL_ca_path => $ssl_ca_path,
				  SSL_verify_mode => $ssl_verify_mode,
				 )
	or die "ERROR: could not initialize SSL context";
}

################################################################################
sub signin {
    my $options = shift;

    my $cookies =
      WWW::Yahoo::Credentials::File->new( file => $options->{cookies},
					  subdir => '.yahoo',
					  filename => 'cookies.txt' );
    warn "INFO: Loading cookies from \"$cookies\"\n" if $options->{debug};
    my $ybc = WWW::Yahoo::Briefcase->new( cookie_jar => $cookies );
    $ybc->overwrite( $options->{overwrite} ) if exists $options->{overwrite};
    $ybc->maxsize( $options->{maxsize} ) if exists $options->{maxsize};
    $ybc->debug( $options->{debug} ) if exists $options->{debug};

    my $lc_userid = lc $options->{userid};
    eval { $ybc->signin( $lc_userid, $options->{password} ) };
    die "ERROR: $@" if $@;

    $ybc;
}

################################################################################
sub perform_command {
    my( $ybc, $options ) = @_;

    return if $options->{command} eq 'signin';
    my $args = $options->{args} ? $options->{args} : [];
    my @result = eval { $ybc->do( $options->{command}, @$args ) };
    die "ERROR: $@" if $@;
    if ( $options->{command} eq 'list' ) {
	foreach my $object ( @result ) {
	    my( $sec, $min, $hour, $mday, $mon, $year ) =
	      gmtime( $object->time );
	    my $fullname = $object->fullname;
	    $fullname .= '/' if $object->type eq 'folder';
	    printf( "%8s  %02d-%s-%04d  %s\n", $object->size,
		    $mday, $month{$mon}, $year+1900, $fullname );
	}
    }
}

################################################################################

__END__

=pod

=head1 NAME

  ybc - interface to Yahoo Briefcase

=head1 SYNOPSIS

  ybc --help
  ybc create folder subfolder(s)
  ybc list folder
  ybc delete folder object(s)
  ybc upload folder file(s)
  ybc download folder file(s)
  ybc rename folder object name  # note: do not include extension on new name
  ybc move folder destination objects(s)
  ybc copy folder destination objects(s)
  ybc signout

=head1 OPTIONS

  -h, --help                    brief help message
      --man                     full documentation
  -q, --quiet                   do not display informational messages
  -v, --verbose                 display informational messages
      --debug=DEBUG             set debugging/verbosity level
  -o, --overwrite               overwrite files
      --nooverwrite             do not overwrite files
      --overwrite-prefix=PREFIX create new object with prefix before overwriting
      --max-size=MAXSIZE        maximum size of file upload allowed
  -u, --userid=USERID           userid to use when signing in
  -p, --password=PASSWORD       password to use when signing in
      --password-fd=FD          get password from file descriptor number, e.g. 0
      --prompt                  prompt for userid and password
      --ssl-ca-path=PATH        path to SSL CA certs directory
      --ssl-ca-file=FILE        path to SSL CA certs file
      --cookies=FILE            file for storing cookies
      --credentials=FILE        file containing userids and passwords

=head1 DESCRIPTION

This program provides command-line access to your Yahoo Briefcase.
You can upload and download files and perform other operations such as
list, rename, move, copy, and delete.  Detailed information on each of
these operations can be found in L<WWW::Yahoo::Briefcase>.

The debugging/verbosity level can be set to a specific integer with
the --debug option, or it can be set with the options --quiet
(--debug=0) or --verbose (--debug=1).  A level of 0 inhibits all
informational/debugging messages--only error messages will be printed
(this is the default).  A level of 1 will display informational
messages.  A level of 2 will display the requests and responses being
sent.

To overwrite files/folders when uploading, downloading, renaming,
moving, copying, or creating new folders, specify the --overwrite
option.  The default is not to overwrite files.  When overwriting, any
conflicting files will be deleted before the requested operation is
performed.  Alternatively, if you specify a prefix with
--overwrite-prefix, then the new file will be created with the prefix,
and only if the operation is successful will the old file be deleted
and the new file renamed (this prefixing feature is not available when
moving or copying).

To set the maximum size of a file upload, specify the --max-size
option.  Note that this setting is not a user preference but is
instead a limitation imposed on uploads to your briefcase.  That is,
you have no control over it.  This method exists solely so that you
can inform this program what your limit is, so that the program will
not attempt to upload files larger than the limit.  The standard file
size limit is 5MB, but with Premium Service it is 15MB.

If you do not specify your userid on the command line, the first one
found in ~/.yahoo/credentials.xml will be used.  Note that your userid
will be converted to lowercase before signing in.  If you do not
specify your password on the command line, it will be looked up in
~/.yahoo/credentials.xml.  Multiple userids and passwords can be
specified in this file--you can choose which password to use by just
specifying the userid.  A different location for the credentials file
can be specified with the --credentials option.

If the userid and/or password are not defined on the command line nor
can be found in the credentials XML file, then they will be prompted
for.  To skip the credentials file, use the --prompt option.

You can also specify a password by passing it in through a file
descriptor using the password-fd option, for example, to get the
password through a shell pipe from another program:

  echo-password | ybc --userid=me --password-fd=0 list folder

The SSL options can be used to specify the location of Certificate
Authority Certificates (CA Certs) to perform certificate validation
when connecting to Yahoo's sign-in server.  The path to a directory
containing CA Certs can be specified with the option --ssl-ca-path,
for example, /etc/ssl/certs, and/or the path to a file containing CA
Certs can be specified with the option --ssl-ca-file, for example,
/etc/apache/ssl.crt/ca-bundle.crt.  If either (or both) of these
options are specified, then the module IO::Socket::SSL will be loaded
and the SSL context will be initialized with peer certificate
validation enabled.  If you do not specify either of these options,
then the IO::Socket::SSL module will be not be loaded by this script;
instead, LWP will automatically load whatever SSL module is installed
(IO::Socket::SSL or Net::SSL from Crypt-SSLeay).

Any cookies returned from Yahoo after signing in will be stored in
~/.yahoo/cookies.txt to be used on future invocations to bypass the
sign-in step.  A different location for this file can be specified
with the --cookies option.

Often-used options may be specified in the file ~/.ybc, for example,
it could contain the following lines:

  --verbose --overwrite
  --max-size=15728640
  --ssl-ca-path /etc/ssl/certs

=head1 FILES

  ~/.yahoo/credentials.xml
  ~/.yahoo/cookies.txt
  ~/.ybc

=head1 SEE ALSO

L<WWW::Yahoo::Briefcase|WWW::Yahoo::Briefcase>,
L<WWW::Yahoo::Credentials|WWW::Yahoo::Credentials>

=head1 AUTHOR

Ken Neighbors, Ph.D.
ken@nsds.com

=head1 COPYRIGHT AND LICENSE

Copyright 2003 by Ken Neighbors

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself, either Perl version 5.000 or (at
your option) any later version of Perl.  That is, you can redistribute
this program and/or modify it under the terms of either:

  a) the GNU General Public License as published by the Free Software
     Foundation; either version 1, or (at your option) any later version,
     or

  b) the "Artistic License" which comes with Perl, or

  c) the license terms of Perl versions later than 5.000

=cut
