#!/usr/bin/perl -w
#
#    Copyright 2005, Marcus Thiesen (marcus@thiesen.org) All rights reserved.
#
#    This program is free software; you can redistribute it 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.
#
#    On Debian GNU/Linux systems, the complete text of the GNU General
#    Public License can be found in `/usr/share/common-licenses/GPL' and
#    the Artistic Licence in `/usr/share/common-licenses/Artistic'.
#
#    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.  
#
#########################################################################
#
# A userspace filesystem for ftp transfer
# Usage: fuseftp mountpoint [user[:password]@]host &
# 
# Prereq: Fuse, Net::FTP, Cache::File, Term::ReadKey
# Version: 0.7
# 
#########################################################################

use strict;
use warnings;

#core
use POSIX qw(:errno_h :fcntl_h);
use File::Spec::Functions;

#preregs
use Net::FTP;
use Fuse;
use Term::ReadKey;

use constant DEBUG => 0;

our $VERSION;

$VERSION = '0.8';

#initial stuff
my $homedir = catdir($ENV{HOME},'.fuseftp');
mkdir $homedir unless -d $homedir;

#get command line arguments
my @opts = grep /^-/, @ARGV;
my @other = grep /^[^-]/, @ARGV;
my $mountpoint = shift @other;
my $server = shift @other;

my @arg_opts = map { split( /=/, $_ ) } grep( /=/, @opts);
my %arg_opts = (
		"--cache" => "file",
		"--timeout" => "300",
		"--port" => "21",
		@arg_opts,
    );
map { $arg_opts{$_}++ } grep /^[^=]+$/, @opts;

if ($arg_opts{"-h"} || $arg_opts{"--help"}) {
    print join "", <DATA>;
    exit(0);
}

unless (defined $mountpoint && defined $server) {
    print("$0 [options] mountpoint [user[:password]@]host[:directory]\n");
    exit 1;
}

print "fuseftp $VERSION - 2005 (c) by Marcus Thiesen <marcus\@thiesen.org>\n";

my $timeout = $arg_opts{"--timeout"};
my $port = $arg_opts{"--port"};

my $filecache;
if ($arg_opts{"--cache"} eq "file") {
    require Cache::File;
    $filecache = new Cache::File( cache_root => $homedir,
				 default_expires => $timeout );
}
if ($arg_opts{"--cache"} eq "memory") {
    require Cache::Memory;
    $filecache = new Cache::Memory( default_expires => $timeout );
}

#split them
my ($username, $password, $host, $basedir);
my (@parts) = split /@/, $server;
my ($left, $right);
if (@parts <= 2) {
    ($left, $right) = @parts;
} else {
    $right = pop @parts;
    $left = join '@', @parts;
}

unless (defined $right) {
    $right = $left;
    undef $left;
}

($username, $password) = split /:/, $left if defined $left;
($host, $basedir) = split /:/, $right if defined $right;

$basedir = '/' unless defined $basedir;

if ($arg_opts{'--ask-password'}) {
    if ((!defined $password) || ($password eq "")) {
        syswrite STDOUT, "Password: ";
        ReadMode('noecho');
        $password = ReadLine(0);
        chomp($password);
        ReadMode('restore');
        print "\n";
    }
}

print "username: $username\npassword: $password\nhost: $host\ndir: $basedir\n"
    if DEBUG;

#make the connection
my $ftp;
if ($arg_opts{'--passive'}) {
    $ftp = new Net::FTP($host, Passive => 1, Port => $port);
} else {
    $ftp = new Net::FTP($host, Port => $port);
}
$ftp or die "Couldn't make FTP connection to $host on port $port: $@!\n";

die "Mountpoint $mountpoint does not exist or is busy\n" unless -d $mountpoint;

$ftp->login($username, $password) or
    die "Login failure!\n";

$ftp->binary;

print "Successfully logged into $host\n"; 

my %attr_cache = ();
my %type_cache = ( $basedir =>  'd' );
my %dir_seen = ();
my %file_obj = ();
my %link_cache = ();
my %file_offset = ();

my $time = time;

#subs
sub ftp_getdir {
    my $dir = shift;
    print "called getdir for '$dir'\n" if DEBUG;

    $ftp->cwd(catdir($basedir,$dir));

    my @files = $ftp->ls();

    map { $_ =~ s|^/|| } @files;

    return (@files, 0);
}

sub ftp_getattr {
    my $filename = shift;

    if (!exists $attr_cache{$filename}) {
	my $base = $basedir;


	if ($filename =~ m|(.+)/[^/]+|) {
	    $base = catdir($basedir, $1);
	}

	$filename = catdir($basedir, $filename);

	$ftp->cwd($base);

	if (! exists $dir_seen{$base} ) {
	    my @entries = $ftp->dir($base);
	    my @files = sort $ftp->ls($base);
	    foreach my $file (@files) {
		$file =~ s|.*/||g;
		next if $file eq ".";

		my $fileregexp = $file;
		# escape special chars that would otherwise be evaluated in the regexp
		$fileregexp =~ s/(\[|\]|[+*.\$^(){}?])/\\$1/gsi;
		my ($entry) = grep /\s+$fileregexp( ->.+)?$/, @entries;
		if ($entry) {
		    $type_cache{catdir($base,$file)} = substr $entry, 0, 1;
		    print("type for $file is " . $type_cache{catdir($base,$file)} . "\n") 
		    if DEBUG;
		}
	    }
	    $dir_seen{$base}++;
	}

	if ((!$type_cache{$filename}) && $filename ne $base) {
	    $attr_cache{$filename} = undef;
	    print "returning ENOENT for $filename\n" if DEBUG;
	    return -ENOENT();
	}

	my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	    $atime,$mtime,$ctime,$blksize,$blocks);

	my $type = 0100;
	my $modebits = 0666;
	if ($type_cache{$filename} eq 'd') {
	    $type = 0040;
	    $modebits = 0755;
	}
	if ($type_cache{$filename} eq 'l') {
	    $type = 0120
	}

	$mode = ($type << 9) + $modebits;

	$nlink = 1;
	$uid = $<;

	($gid) = split / /, $(;

	$rdev = 0;

	$atime = $ftp->mdtm($filename);
	$atime = $time unless defined $atime;

	$size = $ftp->size($filename);
	$size = 0 unless defined $size;

	$mtime = $atime;
	$ctime = $atime;
	$blksize = 1024;
	$blocks = 1;

	$dev = 0;
	$ino = 0;

	print "returning attr for $filename\n" if DEBUG;
	
	$attr_cache{$filename} = [$dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
		$atime,$mtime,$ctime,$blksize,$blocks];

	return ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
		$atime,$mtime,$ctime,$blksize,$blocks);
    } else {
	print "returning attr for $filename (cached)\n" if DEBUG;
	if (defined $attr_cache{$filename}) {
	    return @{$attr_cache{$filename}};
	} else {
	    return -ENOENT();
	}
    }

}

sub ftp_rename {
    my $oldname = shift;
    my $newname = shift;

    $oldname = catdir($basedir, $oldname);
    $newname = catdir($basedir, $newname);

    if ($ftp->rename($oldname, $newname)) {
	my ($dir) = $newname =~ m|(.+)/.+|;
	delete $dir_seen{$dir} if $dir;
	return 0;
    } else {
	return -EIO();
    }
}

sub ftp_open {
    my $file = shift;
    my $flags = shift;

    $file = catdir($basedir, $file);

    print "open: $file\n" if DEBUG;

    if ($flags & (O_WRONLY | O_APPEND)) {
	print("opening $file for WRONLY | APPEND\n") if DEBUG;
	unless ($filecache->get( $file )) {
	    my $size = $ftp->size($file);
	    if ($size) {
		$file_obj{$file} = $ftp->retr($file);
		my $data = my_read($file, $size);
		$filecache->set($file, $data, 'never');
		$file_obj{$file}->close();
	    }
	}
	$file_obj{$file} = $ftp->stor($file);
	if ($file_obj{$file}) {
	    return 0;
	} else {
	    print("opening failed\n") if DEBUG;
	    return -ENOENT();
	}
    }

    if ($flags & (O_WRONLY)) {
	print("opening $file for WRONLY\n") if DEBUG;
	$file_obj{$file} = $ftp->stor($file);
	if ($file_obj{$file}) {
	    return 0;
	} else {
	    print("opening failed\n") if DEBUG;
	    return -ENOENT();
	}
    }

    print("opening $file for read\n") if DEBUG;
    $file_obj{$file} = $ftp->retr($file);
    if ($file_obj{$file}) {
	return 0;
    } else {
	print("opening failed\n") if DEBUG;
	return -ENOENT();
    }


    return -ENOENT();
}

sub my_read {
    my $file = shift;
    my $size = shift;

    print("reading $size from $file\n") if DEBUG;

    my $retval = "";
    my $buffer = "";
    my $read_total = 0;
    my $read_bytes;
    while ($read_total < $size) {
	my $read_bytes = $file_obj{$file}->read($buffer, $size);
	last if ($read_bytes == 0); #EOF
	$read_total += $read_bytes;
	$retval .= $buffer;
    }

    print ("done ($read_total)\n") if DEBUG;
    return $retval;
}

sub ftp_read {
    my $file = shift;
    my $size = shift;
    my $offset = shift;

    $file = catdir($basedir, $file);

    print "read: $file\n" if DEBUG;
    if (!$file_obj{$file}) {
	return -EIO();
    }
    
    my $data = "";
    if ($filecache->get( $file )) {
	$data = $filecache->get( $file );
	if (length($data) < $offset + $size) {
	    $data .= my_read($file, $size);
	} 
    } else {
	$data = my_read($file, $offset + $size);
    }

    $filecache->set($file, $data, $timeout);
    return substr($data, $offset, $size);
}

sub ftp_release {
    my $file = shift;

    $file = catdir($basedir, $file);

    print("release $file\n") if DEBUG;

    if ($file_obj{$file}) {
	$filecache->remove($file);
	delete $attr_cache{$file};
	$type_cache{$file} = 'f';
	my ($dir) = $file =~ m|(.+)/.+|;
	delete $dir_seen{$dir} if $dir;
	$file_obj{$file}->close;
	delete $file_obj{$file};
	$file_offset{$file} = 0;
	return 0;
    } else {
	warn "Trying to close not open file $file\n";
	return -EIO();
    }
}

sub ftp_readlink {
    my $file = shift;
    my $dir;

    $file = catdir($basedir, $file);

    if (!exists $link_cache{$file}) {
	print "readlink: $file\n" if DEBUG;

	if ($file =~ m|(^/.+/).+|) {
	    $dir = $1;
	}
	$dir = '/' unless $dir;

	my @lines = $ftp->dir($dir);

	my $cfile = $file;
	$cfile =~ s|.*/||;

	foreach my $line (@lines) {
	    print $line . "\n" if DEBUG;
	    if ($line =~ $cfile) {
		my ($link,$target) = split /\s*->\s*/, $line;
		$target =~ s|^$basedir||;
		$link_cache{$file} = $target;
		return $target;
	    }
	}
	return -EIO();
    } else {
	return $link_cache{$file};
    }
}

sub ftp_unlink {
    my $file = shift;

    $file = catdir($basedir, $file);

    print "delete $file\n" if DEBUG;

    if ($ftp->delete($file)) {
	delete $dir_seen{$file};
	delete $type_cache{$file};
	return 0; 
    } else {
	return -EIO();
    }
}

sub ftp_rmdir {
    my $dir = shift;

    $dir = catdir($basedir, $dir);

    if ($ftp->rmdir($dir)) {
	delete $dir_seen{$dir};
	delete $type_cache{$dir};
	return 0;
    } else {
	return -EIO();
    }
}

sub ftp_mkdir {
    my $dir = shift;

    $dir = catdir($basedir, $dir);

    if ($ftp->mkdir($dir)) {
	delete $dir_seen{$dir};
	delete $type_cache{$dir};
	return 0;
    } else {
	return -EIO();
    }
}

sub ftp_write {
    my $file = shift;
    my $buffer = shift;
    my $offset = shift;

    $file = catdir($basedir, $file);

    $file_offset{$file} = 0 unless $file_offset{$file};

    print "write $file (offset $offset)\n" if DEBUG;

    my $data = $filecache->get($file);
    $data = "" unless defined $data;

    $offset = $offset - $file_offset{$file};

    if ($offset == 0) {
	$data = $buffer;
    } else {
	substr $data, $offset, length($buffer), $buffer;
    }

    $filecache->set($file, $data, 'never');

    print "done\n" if DEBUG;

    return length($buffer);
}

sub ftp_flush {
    my $file = shift;

    $file = catdir($basedir, $file);

    print "flush: $file\n" if DEBUG;

    my $data = $filecache->get($file);
    if ($file_obj{$file}) {
	if ($data) {
	    $file_obj{$file}->write($data, length($data));
	    $file_offset{$file} += length($data);
	    $filecache->set($file, "", 'never');
	}
	print "returning from flush\n" if DEBUG;
	return 0;
    } else {
	warn "Trying to flush not open file $file\n";
	return -EIO();
    }
}

sub ftp_mknod{
    my $file = shift;
    my $mode = shift;
    my $device = shift;

    print "mknod $file\n" if DEBUG;

    ftp_open($file, O_WRONLY);
    ftp_write($file, "", 0);
    ftp_flush($file);
    ftp_release($file);

    return 0;
}

sub ftp_truncate{
    my $file = shift;
    my $offset = shift;

    print "truncate $file (offset $offset)\n" if DEBUG;

    if ($offset != 0) {
	ftp_open($file, O_RDONLY);
	my $data = ftp_read($file, $offset, 0);
	ftp_flush($file);
	ftp_release($file);
	ftp_open($file, O_WRONLY);
	ftp_write($file, $data, length($data));
	ftp_flush($file);
	ftp_release($file);
    } else {
	$ftp->delete(catdir($basedir, $file));
	ftp_mknod($file, 0, 0);
    }

    print "finished truncate $file\n" if DEBUG;

    return 0;
}

#run fuse
my @extraargs;
push @extraargs, ("debug", 1) if (exists $arg_opts{"--debug"});
push @extraargs, ("mountopts", $arg_opts{"--options"}) if ($arg_opts{"--options"});

unless (DEBUG || $arg_opts{'--foreground'} || $arg_opts{"--debug"})
{
    # fork and exit parent process to put FuseFtp into background
    print "Backgrounding...\n";
    fork() and exit(0);
}

Fuse::main(mountpoint => $mountpoint,

	   getdir => \&ftp_getdir,
	   getattr => \&ftp_getattr,
	   open => \&ftp_open,
	   read => \&ftp_read,
	   release => \&ftp_release,
	   readlink => \&ftp_readlink,
	   rename => \&ftp_rename,
	   unlink => \&ftp_unlink,
	   rmdir => \&ftp_rmdir,
	   mkdir => \&ftp_mkdir,
	   write => \&ftp_write,
	   flush => \&ftp_flush,
	   mknod => \&ftp_mknod,
	   truncate => \&ftp_truncate,
	   @extraargs,
	   );

__DATA__

Usage: fuseftp [options] mountpoint [user[:password]@]host[:directory]

where options is one of:

  --ask-password      Interactive ask for the password if none provided

  --cache=memory      The default caching uses a file system caching system, if
                      you want to speed things up and won't transfer big files
                      you can use in memory caching.

  --debug             Enable FUSE debugging messages
                      (implies --foreground)

  --foreground        Don't put process into background

  --options=opt[,opt] Pass options to FUSE
                      allow_others: allow access by other users

  --passive           Make a passive FTP connection

  --port=21           Set the port to use for the connection, defaults to
                      21.              

  --timeout=seconds   Timeout for read cache, files will be stored 'seconds' 
                      seconds in the cache. Defaults to 300.


Mountpoint is the directory where the FTP server will be mountet into the filesystem.

The last parameter is the server. 

Examples:
 
   Mounts the directory pub/linux of ftp.kernel.org to ~/kernel using memory cache:

   fuseftp --cache=memory ~/kernel ftp.kernel.org:/pub/linux

   Mounts the FTP server my.isp.com to ~/homepage using username "foo" and password 
   "bar". NOTE: This way your password will show up in the process table. You can
   specify passwords on a per server basis in ~/.netrc

   fuseftp ~/homepage foo:bar@my.isp.com

   
