#!/usr/bin/perl -w
#
# Perl/Tk Sftp Client
#     Cliente  para secure ftp (sftp) em Perl usando interface gráfica
# Tk.
#
# Versões (http://cascavel.pm.org/~frighetti/):
#  0.1_01 - 16/01/2004 - Planejado interface.
#  0.1_02 - 20/01/2004 - Manipulação do objeto Net::SFTP.
#
# Bugs:
#     Icompatibilidade com o modulo Crypt::Random v1.13. Para corrigir
# a falha foi necessário modificar o arquivo Crypt/Random/Generator.pm
# segue o patch:
#
# // Start Generator.patch
# 12c12
# < use Crypt::Random;#qw(makerandom makerandom_itv makerandom_octet);
# ---
# > use Crypt::Random qw(makerandom makerandom_itv makerandom_octet);
# // End of Generator.patch
#
# Copyright 2003 Fabiano Reese Righetti <frighetti@cascavel.pm.org>
# All rights reserved.
#
# English (http://www.gnu.org/licenses/gpl.txt):
#     This  program  is  free software; you can redistribute it and/or
# modify  it  under  the  terms  of  the GNU General Public License as
# published  by  the Free Software Foundation; either version 2 of the
# License, or (at your option) any later version.
#    This  program  is distributed in the hope that it will be useful,
# but  WITHOUT  ANY  WARRANTY;  without  even  the implied warranty of
# MERCHANTABILITY  or  FITNESS  FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# Português (http://www.magnux.org/doc/GPL-pt_BR.txt):
#     Este programa é um software livre; você pode redistribuí-lo e/ou 
# modificá-lo  dentro  dos  termos  da  Licença Pública Geral GNU como 
# publicada  pela  Fundação  do  Software  Livre (FSF); na versão 2 da 
# Licença, ou (na sua opinião) qualquer versão.
#    Este programa é distribuído na esperança que possa ser  útil, mas
# SEM  NENHUMA  GARANTIA;  sem  uma  garantia implícita de ADEQUAÇÂO a
# qualquer  MERCADO ou APLICAÇÃO EM PARTICULAR. Veja a Licença Pública
# Geral GNU para maiores detalhes.

use strict;
use Tk 800.000;
use Net::SFTP;

my $maxX    = 500;
my $maxY    = 330;
my %Frames  = ();
my %Entrys  = ();
my %Values  = (
               'local'   => $ENV{HOME}.'/',
               'remoto'  => '/home/frighetti/',
			   'default' => '/home/frighetti/',
			   'status'  => '',
              );
my %Listas  = ();
my %Labels  = ();
my %Buttons = ();
my $sftp    = undef;

my $main = MainWindow->new(
                           title => 'Perl/Tk Sftp Client',
                          );

$main->geometry($maxX.'x'.$maxY);

&interface;

MainLoop;

sub interface
{
	&topo;

	&meio;

	&abaixo;
}

sub topo
{
	$Frames{topo} = $main->Frame();

	&descricao;

	&dados;

	$Frames{topo}->pack(-pady => 15);
}

sub descricao
{
	$Frames{descricao} = $Frames{topo}->Frame();

	$Labels{host} = $Frames{descricao}->Label(
	                                          -text  => 'Host',
	                                          -width => 25,
	                                        )->pack(-side => 'left');

	$Labels{porta} = $Frames{descricao}->Label(
	                                           -text  => 'Porta',
	                                           -width => 6,
	                                          )->pack(-side => 'left', -padx => 6);

	$Labels{usuario} = $Frames{descricao}->Label(
	                                             -text  => 'Usuário',
	                                             -width => 14,
	                                            )->pack(-side => 'left', -padx => 6);

	$Labels{senha} = $Frames{descricao}->Label(
	                                           -text  => 'Senha',
	                                           -width => 14,
	                                          )->pack(-side => 'left');

	$Frames{descricao}->pack();
}

sub dados
{
	$Frames{dados} = $Frames{topo}->Frame();

	$Values{host} = '';
	$Entrys{host} = $Frames{dados}->Entry(
										  -textvariable => \$Values{host},
										  -background   => 'gray',
										  -width        => 25,
										 )->pack(-side => 'left');
	$Entrys{host}->bind("<KeyPress>", sub
	                                  {
										  &valid_params ?
		                                     $Buttons{conectar}->configure(-state => 'normal')
											            :
		                                     $Buttons{conectar}->configure(-state => 'disabled');
		                              });

	$Values{porta} = '';
	$Entrys{porta} = $Frames{dados}->Entry(
										   -textvariable => \$Values{porta},
										   -background   => 'gray',
										   -width        => 6,
										  )->pack(-side => 'left', -padx => 6);
	$Entrys{porta}->insert('end', '22');
	$Entrys{porta}->bind("<KeyPress>", sub
	                                   {
					 					   &valid_params ?
		                                      $Buttons{conectar}->configure(-state => 'normal')
											             :
		                                      $Buttons{conectar}->configure(-state => 'disabled');
		                               });

	$Values{usuario} = '';
	$Entrys{usuario} = $Frames{dados}->Entry(
											 -textvariable => \$Values{usuario},
											 -background   => 'gray',
											 -width        => 14,
										    )->pack(-side => 'left', -padx => 6);
	$Entrys{usuario}->bind("<KeyPress>", sub
	                                     {
										     &valid_params ?
		                                        $Buttons{conectar}->configure(-state => 'normal')
											               :
		                                        $Buttons{conectar}->configure(-state => 'disabled');
		                                 });

	$Values{senha} = '';
	$Entrys{senha} = $Frames{dados}->Entry(
										   -textvariable => \$Values{senha},
										   -background => 'gray',
										   -width => 14,
										   -show => '*',
										  )->pack(-side => 'left');
	$Entrys{senha}->bind("<KeyPress>", sub
	                                   {
					 					   &valid_params ?
		                                      $Buttons{conectar}->configure(-state => 'normal')
											             :
		                                      $Buttons{conectar}->configure(-state => 'disabled');
		                               });

	$Frames{dados}->pack();
}

sub meio
{
	$Frames{meio} = $main->Frame(-borderwidth => 2);

	&local;

	&remoto;

	&controle;

	$Frames{meio}->pack(-side => 'top', -padx => 3, -fill => 'x');
}

sub local
{
	$Frames{local} = $Frames{meio}->Frame();

	$Labels{local} = $Frames{local}->Label(
	                                       -textvariable => \$Values{local},
	                                       -relief       => 'groove',
	                                       -width        => 20,
								          )->pack(pady => 3, -fill => "x");

	$Listas{local} = $Frames{local}->Scrolled(
											  "Listbox",
											  -scrollbars => "osoe",
											 )->pack();

	$Listas{local}->bind('<ButtonRelease-1>' => sub { $Buttons{put}->configure(-state => 'normal') if $sftp } );
	$Listas{local}->bind('<Double-ButtonRelease-1>' => sub { &local_click($Listas{local}->get('active'))  } );

	&list_dir_local($Values{local});

	$Frames{local}->pack(-side => "left", -anchor => 'nw', padx => 3);
}

sub remoto
{
	$Frames{remoto} = $Frames{meio}->Frame();

	$Labels{remoto} = $Frames{remoto}->Label(
	                                         -textvariable => \$Values{remoto},
	                                         -relief       => 'groove',
	                                         -width        => 20,
	                                        )->pack(pady => 3, -fill => "x");

	$Listas{remoto} = $Frames{remoto}->Scrolled(
												"Listbox",
												-scrollbars => "osoe",
											   )->pack();
	
	$Listas{remoto}->bind('<ButtonRelease-1>' => sub { $Buttons{get}->configure(-state => 'normal') if $sftp } );
	$Listas{remoto}->bind('<Double-ButtonRelease-1>' => sub { &remoto_click($Listas{remoto}->get('active')) } );

	$Frames{remoto}->pack(-side => "right", -anchor => 'ne', padx => 3);
}

sub controle
{
	$Frames{controle} = $Frames{meio}->Frame();

	$Buttons{sair} = $Frames{controle}->Button(
	                                           -text => "Sair",
	                                           -command => sub { exit },
	                                          )->pack(-side => 'bottom', -fill => 'x');
	&bind_message($Buttons{sair}, 'Click para sair do programa');

	$Buttons{desconectar} = $Frames{controle}->Button(
	                                                  -text => "Desconectar",
	                                                  -command => sub { &desconectar },
													  -state => 'disabled',
	                                                 )->pack(-side => 'bottom', -fill => 'x', -pady => 5);
	&bind_message($Buttons{desconectar}, 'Desconectar do host remoto');

	$Buttons{conectar} = $Frames{controle}->Button(
	                                               -text => "Conectar",
	                                               -command => sub { &conectar },
												   -state => 'disabled',
	                                              )->pack(-side => 'bottom', -fill => 'x');
	&bind_message($Buttons{conectar}, 'Conectar ao host remoto');
	
	$Buttons{put} = $Frames{controle}->Button(
	                                          -text => "------------>",
	                                          -command => sub {  },
											  -state => 'disabled',
	                                         )->pack(-side => 'bottom', -fill => 'x', -pady => 5);
	&bind_message($Buttons{put}, 'Enviar arquivo ou diretório');

	$Buttons{get} = $Frames{controle}->Button(
	                                          -text => "<------------",
	                                          -command => sub {  },
											  -state => 'disabled',
	                                         )->pack(-side => 'bottom', -fill => 'x');
	&bind_message($Buttons{get}, 'Baixar arquivo ou diretório');

	$Frames{controle}->pack(-side => 'bottom', -padx => 3, -fill => 'x');
}

sub abaixo
{
	$Frames{abaixo} = $main->Frame();

	&status;

	$Frames{abaixo}->pack(-side => 'bottom', -fill => 'x');
}

sub status
{
	$Frames{status} = $Frames{abaixo}->Frame();
	
	$Labels{status} = $Frames{status}->Label(
											 -textvariable => \$Values{status},
	                                         -relief       => 'groove',
											 -width        => $maxX,
	                                        )->pack();

	$Frames{status}->pack(-side => 'bottom');
}

# Função adaptada do livro:
#
# O'Reilly - Mastering Perl/Tk by Steve Lidie and Nancy Walsh
# ISBN 1-56592-716-8
# First Edition, published January 2002.
sub bind_message {
	my ($widget, $msg) = @_;

	$widget->bind('<Enter>', [ sub { $Values{status} = $_[1]; }, $msg ]);
	$widget->bind('<Leave>',   sub { $Values{status} = '';    }        );
}

# NAME
# 	list_dir_local
#
# SYNOPSIS
# 	void list_dir_local (string)
#
# FUNCTION
# 	Abre o diretorio passado por parâmetro e o lista na listbox "local".
#
# MODIFICATION HISTORY
# 	2003-01-13 v0.0a Fabiano Reese Righetti
#
# ATTRIBUTES
# 	string					-- nome do diretório
#
# SIDE EFFECTS
# 	$Listas{local} modificado.
#
# EXAMPLE
# 	&list_dir_local($Values{local});
#
# AUTHOR
# 	Fabiano Reese Righetti <frighetti@cascavel.pm.org>
sub list_dir_local
{
	my $diretorio = shift;

	opendir (DIR, $diretorio);
	
		my @temp = ();
	
		for my $arquivo (readdir (DIR))
		{
			if (-d $Values{local}.'/'.$arquivo)
			{
				push (@temp, $arquivo.'/');
			}
			else
			{
				push (@temp, $arquivo);
			}
		}
	
		@temp = ('.', '..') if $#temp == -1;
		
		$Listas{local}->delete(0, 'end');
		$Listas{local}->insert(0, sort @temp);
	
	closedir (DIR);
}

# NAME
# 	local_click
#
# SYNOPSIS
# 	void local_click (string)
#
# FUNCTION
# 	Manipula a ação que deverá ser tomada após um click em qualquer
# elemento da listbox 'local'.
#
# MODIFICATION HISTORY
# 	2003-01-14 v0.0a Fabiano Reese Righetti
#
# ATTRIBUTES
# 	string					-- elemento selecionado na listbox.
#
# SIDE EFFECTS
# 	$Listas{local} modificado.
#
# EXAMPLE
# 	&local_click($Listas{local}->get('active'));
#
# AUTHOR
# 	Fabiano Reese Righetti <frighetti@cascavel.pm.org>
sub local_click
{
	my $arquivo = shift;

	if ($arquivo eq '../')
	{
		$Values{local} =~ s/[^\/]+\/$//;
		$Values{local} = '/' if ($Values{local} eq '');

		&list_dir_local($Values{local});
	}
	elsif ($arquivo ne './')
	{
		if ($arquivo =~ /\/$/)
		{
			$Values{local} .= '/'.$arquivo.'/';
			$Values{local} =~ s/\/\//\//g;
			
			&list_dir_local($Values{local});
		}
	}
	
	$Buttons{put}->configure(-state => 'disabled');
}

# NAME
# 	valid_params
#
# SYNOPSIS
# 	int valid_params ()
#
# FUNCTION
# 	Valida os dados fornecidos pelo usuário (host, porta, usuário
# e senha).
#
# MODIFICATION HISTORY
# 	2003-01-17 v0.0a Fabiano Reese Righetti
#
# RESULT
# 	0					-- dados errados
# 	1					-- dados válidos
#
# EXAMPLE
# 	&valid_params ? '' : '';
#
# AUTHOR
# 	Fabiano Reese Righetti <frighetti@cascavel.pm.org>
sub valid_params
{
	if (($Values{host} ne '')     and
	    ($Values{porta} !~ /[^\d]+/) and
		($Values{usuario} ne '')  and
		($Values{senha} ne ''))
	{
		return 1;
	}
	else
	{
		return 0;
	}
}

# NAME
# 	conectar
#
# SYNOPSIS
# 	void conectar ()
#
# FUNCTION
# 	Cria um novo objeto de conexão Net::SFTP.
#
# MODIFICATION HISTORY
# 	2003-01-19 v0.0a Fabiano Reese Righetti
#
# SIDE EFFECTS
# 	$sftp modificado.
#
# EXAMPLE
# 	&conectar();
#
# AUTHOR
# 	Fabiano Reese Righetti <frighetti@cascavel.pm.org>
sub conectar
{
	if (&valid_params)
	{
		$sftp = Net::SFTP->new(
		                       $Values{host},
							   port     => $Values{porta},
							   user     => $Values{usuario},
							   password => $Values{senha},
							   #debug    => 1,
							  ) || die "error connecting to $Values{host}";

		$Buttons{conectar}->configure(-state => 'disabled');
		$Buttons{desconectar}->configure(-state => 'normal');
		&list_dir_remoto($Values{remoto});
	}
	else
	{
	}
}

# NAME
# 	list_dir_remoto
#
# SYNOPSIS
# 	void list_dir_remoto (string)
#
# FUNCTION
# 	Abre o diretorio passado por parâmetro e o lista na listbox "remoto".
#
# MODIFICATION HISTORY
# 	2003-01-19 v0.0a Fabiano Reese Righetti
#
# ATTRIBUTES
# 	string					-- nome do diretório
#
# SIDE EFFECTS
# 	$Listas{remoto} modificado.
#
# EXAMPLE
# 	&list_dir_remoto($Values{remoto});
#
# AUTHOR
# 	Fabiano Reese Righetti <frighetti@cascavel.pm.org>
sub list_dir_remoto
{
	my $diretorio = shift;

	my @temp = ();
	
	for my $arquivo ($sftp->ls($diretorio))
	{
		if ($arquivo->{longname} =~ /^d/)
		{
			push (@temp, $arquivo->{filename}.'/');
		}
		else
		{
			push (@temp, $arquivo->{filename});
		}
	}
	
	@temp = ('./', '../') if $#temp == -1;

	$Listas{remoto}->delete(0, 'end');
	$Listas{remoto}->insert(0, sort @temp);
}

# NAME
# 	remoto_click
#
# SYNOPSIS
# 	void remoto_click (string)
#
# FUNCTION
# 	Manipula a ação que deverá ser tomada após um click em qualquer
# elemento da listbox 'remoto'.
#
# MODIFICATION HISTORY
# 	2003-01-19 v0.0a Fabiano Reese Righetti
#
# ATTRIBUTES
# 	string					-- elemento selecionado na listbox.
#
# SIDE EFFECTS
# 	$Listas{remoto} modificado.
#
# EXAMPLE
# 	&remoto_click($Listas{remoto}->get('active'));
#
# AUTHOR
# 	Fabiano Reese Righetti <frighetti@cascavel.pm.org>
sub remoto_click
{
	my $arquivo = shift;

	if ($arquivo eq '../')
	{
		$Values{remoto} =~ s/[^\/]+\/$//;
		$Values{remoto} = '/' if ($Values{remoto} eq '');

		&list_dir_remoto($Values{remoto});
	}
	elsif ($arquivo ne './')
	{
		if ($arquivo =~ /\/$/)
		{
			$Values{remoto} .= '/'.$arquivo.'/';
			$Values{remoto} =~ s/\/\//\//g;
			
			&list_dir_remoto($Values{remoto});
		}
	}
	
	$Buttons{get}->configure(-state => 'disabled');
}

# NAME
# 	desconectar
#
# SYNOPSIS
# 	void desconectar ()
#
# FUNCTION
# 	Apaga o objeto de conexão Net::SFTP.
#
# MODIFICATION HISTORY
# 	2003-01-19 v0.0a Fabiano Reese Righetti
#
# SIDE EFFECTS
# 	$sftp modificado.
#
# EXAMPLE
# 	&desconectar();
#
# AUTHOR
# 	Fabiano Reese Righetti <frighetti@cascavel.pm.org>
sub desconectar
{
	$sftp = undef;
	
	$Buttons{desconectar}->configure(-state => 'disabled');
	$Buttons{get}->configure(-state => 'disabled');
	$Buttons{put}->configure(-state => 'disabled');
	$Buttons{conectar}->configure(-state => 'normal') if &valid_params;
	
	$Values{remoto} = $Values{default};
	
	$Listas{local}->selectionClear(0, "end");
	$Listas{remoto}->delete(0, 'end');
}