AC-MrGamoo

 view release on metacpan or  search on metacpan

lib/AC/MrGamoo/API/Get.pm  view on Meta::CPAN

    my $sha1 = sha1_file($file);

    debug("get file '$file' size $size");

    # send header
    my $gb  = ACPScriblReply->encode( { status_code => 200, status_message => 'OK', hash_sha1 => $sha1 } );
    my $hdr = AC::MrGamoo::Protocol->encode_header(
        type		=> $proto->{type},
        msgidno		=> $proto->{msgidno},
        is_reply	=> 1,
        data_length	=> length($gb),
        content_length	=> $size,
       );
    my $buf = $hdr . $gb;

    syswrite( $fd, $buf );

    # stream
    AC::MrGamoo::Protocol->sendfile($fd, \*F, $size);
}

lib/AC/MrGamoo/API/Put.pm  view on Meta::CPAN

    eval{ mkpath($dir, undef, 0755) };

    # open tmp
    my $tmp = "$file.tmp";
    unless( open(F, "> $tmp") ){
        problem("open file failed: $!");
        return nbfd_reply(500, 'error', $fd, $proto, $req);
    }

    # read + write
    my $size = $proto->{content_length};
    my $sha1 = $req->{hash_sha1};

    verbose("put file '$file' size $size");

    if( $content ){
        syswrite( F, $content );
        $size -= length($content);
    }

    eval {
        my $chk = AC::MrGamoo::Protocol->sendfile(\*F, $fd, $size, 10);
        close F;
        die "file size mismatch\n" unless (stat($tmp))[7] == $proto->{content_length};
        die "SHA1 check failed\n" if $sha1 && $sha1 ne $chk;
    };
    if(my $e = $@){
        unlink $tmp;
        verbose("error: $e");
        nbfd_reply(500, 'error', $fd, $proto, $req);
        return;
    }

    rename $tmp, $file;

lib/AC/MrGamoo/Kibitz/Client.pm  view on Meta::CPAN

    $me->set_callback('timeout',  \&timeout);
    $me->set_callback('read',     \&read);
    $me->set_callback('shutdown', \&shutdown);

    $me->start();

    # build request
    my $req = AC::MrGamoo::Protocol->encode_request( {
        type            => 'mrgamoo_status',
        content_length  => 0,
        want_reply      => 1,
        msgid           => $msgid++,
    }, {
        myself => AC::MrGamoo::Kibitz->about_myself(),
    } );

    # write request
    $me->write( $req );
    $me->timeout_rel($TIMEOUT);

lib/AC/MrGamoo/OutFile.pm  view on Meta::CPAN

sub output {
    my $me  = shift;

    $me->{lastused} = $^T;	# $^T as been updated with current time

    if( my $fd = $me->{fd} ){
        print $fd @_;
    }else{
        $me->{buffer} .= $_ for @_;
        $me->_flush() if length($me->{buffer}) >= $BUFMAX;
    }
}

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

sub DESTROY {
    my $me = shift;
    $me->close();
}

lib/AC/MrGamoo/Protocol.pm  view on Meta::CPAN

    my $evt = shift;

    $io->{rbuffer} .= $evt->{data};

    return read_http($io, $evt) if $io->{rbuffer} =~ /^GET/;

    my $p = _check_protocol( $io, $evt );
    return unless $p; 	# read more

    # do we have everything?
    return unless length($io->{rbuffer}) >= ($p->{data_length} + $p->{content_length} + $HDRSIZE);

    my $data    = substr($io->{rbuffer}, $HDRSIZE, $p->{data_length});
    my $content = substr($io->{rbuffer}, $HDRSIZE + $p->{data_length}, $p->{content_length});

    # content is passed as reference
    return ($p, $data, ($content ? \$content : undef));
}

sub read_protocol_no_content {
    my $io  = shift;
    my $evt = shift;

    $io->{rbuffer} .= $evt->{data};

    return _read_http($io, $evt) if $io->{rbuffer} =~ /^GET/;

    my $p = _check_protocol( $io, $evt );
    return unless $p; 	# read more

    # do we have everything?
    return unless length($io->{rbuffer}) >= ($p->{data_length} + $HDRSIZE);

    my $data    = substr($io->{rbuffer}, $HDRSIZE, $p->{data_length});
    my $content = substr($io->{rbuffer}, $HDRSIZE + $p->{data_length}, $p->{content_length});

    return ($p, $data, $content);
}

sub _check_protocol {
    my $io  = shift;
    my $evt = shift;

    if( length($io->{rbuffer}) >= $HDRSIZE && !$io->{proto_header} ){
        # decode header
        eval {
            $io->{proto_header} = __PACKAGE__->decode_header( $io->{rbuffer} );
        };
        if(my $e=$@){
            verbose("cannot decode protocol header: $e");
            $io->run_callback('error', {
                cause	=> 'read',
                error	=> "cannot decode protocol: $e",
            });

lib/AC/MrGamoo/Server.pm  view on Meta::CPAN

    my $f = $HTTP{$base};
    $f ||= \&http_notfound;
    my( $content, $code, $text ) = $f->($url);
    $code ||= 200;
    $text ||= 'OK';

    my $res = "HTTP/1.0 $code $text\r\n"
      . "Server: AC/MrGamoo\r\n"
      . "Connection: close\r\n"
      . "Content-Type: text/plain; charset=UTF-8\r\n"
      . "Content-Length: " . length($content) . "\r\n"
      . "\r\n"
      . $content ;

    $me->write_and_shut($res);
}

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

sub http_notfound {
    my $url = shift;

lib/AC/MrGamoo/Xfer.pm  view on Meta::CPAN

        # connect
        my $s = AC::MrGamoo::Protocol->connect_to_server( inet_aton($addr), $port );
        return unless $s;

        # send req
        AC::MrGamoo::Protocol->write_request($s, $req);

        # get response
        my $buf = AC::MrGamoo::Protocol->read_data($s, AC::MrGamoo::Protocol->header_size(), 30);
        $p      = AC::MrGamoo::Protocol->decode_header($buf);
        $p->{data} = AC::MrGamoo::Protocol->read_data($s, $p->{data_length}, 1);
        $p->{data} = AC::MrGamoo::Protocol->decode_reply($p);

        debug("recvd response $p->{data}{status_code}");
        return unless $p->{data}{status_code} == 200;

        # stream file to disk
        my $size = $p->{content_length};
        debug("recving file ($size B)");

        my $fd;
        unless( open( $fd, "> $tmpfile" ) ){
            verbose("cannot open output file '$tmpfile': $!");
            return;
        }

        my $chk  = _sendfile($oreq, $fd, $s, $size);
        my $sha1 = $p->{data}{hash_sha1};