view release on metacpan or  search on metacpan

script/otfile  view on Meta::CPAN

#!/usr/bin/env perl

use 5.0101;
use warnings;
use strict;
use autodie;

use Pod::Usage;
use Getopt::Long;
use File::Basename;
use IO::Socket::INET;

my $port           = 1234;
my $auto_port      = 0;
my $serve_multiple = 0;
my $serve_self     = 0;
my $uuid           = '';

GetOptions(
    'auto'     => \$auto_port,
    'port=i'   => \$port,
    'multiple' => \$serve_multiple,
    'self'     => \$serve_self,
    'uuid=s'   => \$uuid,
    'help'     => sub { pod2usage(1) } ) or pod2usage(2);

unshift @ARGV, __FILE__ if $serve_self;
my $file = shift or do { warn "Must provide file to serve\n"; pod2usage(2) };
die "Unable to read '$file'\n" unless -r $file;

# try loading some optional dependencies
my %opt_depend;

# we try for Mac::Pasteboard first for pre 0.06 people that have it
# but don't have Clipboard installed

eval { require Mac::Pasteboard; $opt_depend{pasteboard} = 1 };
eval { require Clipboard;       $opt_depend{clipboard}  = 1 }
    unless $opt_depend{pasteboard};
eval { require File::MMagic;      $opt_depend{mmagic}     = 1 };
eval { require UUID::Tiny;        $opt_depend{uuid}       = 1 };
eval { require URI::Escape;       $opt_depend{uri_escape} = 1 };
eval { require Term::ProgressBar; $opt_depend{progress}   = 1 };

my $type     = get_file_type($file);
my $size     = -s $file;
my $filename = fileparse($file);
my $ip       = get_local_ip();
$uuid      ||= gen_uniq_string();
my $path     = "/$uuid/" . check_escape($filename);

my $server;
while ( !$server ) {
    $server = IO::Socket::INET->new(
        Listen    => 5,
        LocalAddr => $ip,
        LocalPort => $port,
        Proto     => 'tcp'
    );
    last if $server;
    if ( !$auto_port || $! ne 'Address already in use' ) {
        die "Couldn't open socket for listening: $!\n";
    }
    $port++;
}

my $url = "http://$ip:$port$path";

say "Serving '$file' as '$filename', size $size, type $type";

if ( $opt_depend{pasteboard} ) {
    Mac::Pasteboard::pbcopy($url);
    say "$url copied to clipboard.";
}
elsif ( $opt_depend{clipboard} ) {
    Clipboard->import;    # finds OS driver
    Clipboard->copy($url);
    say "$url copied to clipboard.";
}
else {
    say $url;
}

while ( my $client = $server->accept() ) {
    say 'I: Connect from ' . $client->peerhost;
    my $requested_path;
    LINE: while ( my $line = <$client> ) {
        last if $line =~ m/^\s*$/;
        $requested_path = $1 if $line =~ /^GET (\S+) /;
    }
    if ( $path ne $requested_path ) {
        say "E: Invalid request for $requested_path";
        say $client "HTTP/1.0 403 Forbidden FOAD.\n\n";
        close $client;
        next;
    }
    open my $fh, "<", $file;

    say $client "HTTP/1.0 200 OK";
    say $client "Pragma: no-cache";
    say $client "Content-type: $type";
    say $client "Content-length: $size";
    say $client "Content-disposition: inline; filename=\"$filename\"";
    say $client "";

    my $p;
    if ( $opt_depend{progress} ) {
        $p = Term::ProgressBar->new(
            {   name       => $filename,
                count      => $size,
                ETA        => "linear",
                term_width => 40,
            } );
        $p->minor(0);
    }
    else {
        say "Serving file.";
    }

    my $total = 0;
    while ( my $len = sysread $fh, my $buf, 4096 ) {
        print $client $buf;
        $total += $len;
        $p->update($total) if $opt_depend{progress};
    }
    $p->update($size) if $opt_depend{progress};
    say "\nDone.";

    close $fh;
    $client->close;
    $server->shutdown(2) unless $serve_multiple;
    $server->close unless $serve_multiple;
}

# From Net::Address::IP::Local
sub get_local_ip {
    my $socket = IO::Socket::INET->new(
        Proto    => 'udp',