App-MBUtiny
view release on metacpan or search on metacpan
eg/server.cgi view on Meta::CPAN
User-Agent: lwp-request/6.15 libwww-perl/6.15
Content-Length: 73820
Content-Type: application/octet-stream
201 Created
Connection: close
Date: Tue, 25 Jun 2019 16:41:42 GMT
Server: Apache/2.2.25 (Win32) mod_ssl/2.2.25 OpenSSL/0.9.8y mod_perl/2.0.8 Perl/v5.16.3
Content-Length: 0
Content-Location: /mbuserver/foo/bar/file.tar.gz
Content-Type: application/octet-stream; charset=ISO-8859-1
Client-Date: Tue, 25 Jun 2019 16:41:43 GMT
Client-Peer: 127.0.0.1:80
Client-Response-Num: 1
=item B<GET /mbuserver>
lwp-request -E "http://localhost/mbuserver/foo/bar"
Get list of available files in text/plain format, output is in "ls -1" format
GET http://localhost/mbuserver/foo/bar
User-Agent: lwp-request/6.15 libwww-perl/6.15
200 OK
Connection: close
Date: Tue, 25 Jun 2019 16:49:05 GMT
Server: Apache/2.2.25 (Win32) mod_ssl/2.2.25 OpenSSL/0.9.8y mod_perl/2.0.8 Perl/v5.16.3
Content-Type: text/plain; charset=utf-8
Client-Date: Tue, 25 Jun 2019 16:49:05 GMT
Client-Peer: 127.0.0.1:80
Client-Response-Num: 1
Client-Transfer-Encoding: chunked
file.tar.gz
=item B<HEAD /mbuserver/file.tar.gz>
lwp-request -E -m HEAD "http://localhost/mbuserver/foo/bar/file.tar.gz"
eg/server.cgi view on Meta::CPAN
Returns info about file.tar.gz file in HTTP headers
HEAD http://localhost/mbuserver/foo/bar/file.tar.gz
User-Agent: lwp-request/6.15 libwww-perl/6.15
302 Found
Connection: close
Date: Tue, 25 Jun 2019 16:49:43 GMT
Location: /foo/bar/file.tar.gz
Server: Apache/2.2.25 (Win32) mod_ssl/2.2.25 OpenSSL/0.9.8y mod_perl/2.0.8 Perl/v5.16.3
Content-Type: text/plain; charset=utf-8
Client-Date: Tue, 25 Jun 2019 16:49:43 GMT
Client-Peer: 127.0.0.1:80
Client-Response-Num: 1
HEAD http://localhost/foo/bar/file.tar.gz
User-Agent: lwp-request/6.15 libwww-perl/6.15
200 OK
Connection: close
Date: Tue, 25 Jun 2019 16:49:43 GMT
eg/server.cgi view on Meta::CPAN
GET http://localhost/mbuserver/foo/bar/file.tar.gz
User-Agent: lwp-request/6.15 libwww-perl/6.15
302 Found
Connection: close
Date: Tue, 25 Jun 2019 16:50:50 GMT
Location: /foo/bar/file.tar.gz
Server: Apache/2.2.25 (Win32) mod_ssl/2.2.25 OpenSSL/0.9.8y mod_perl/2.0.8 Perl/v5.16.3
Content-Length: 0
Content-Type: text/plain; charset=utf-8
Client-Date: Tue, 25 Jun 2019 16:50:50 GMT
Client-Peer: 127.0.0.1:80
Client-Response-Num: 1
X-Pad: avoid browser bug
GET http://localhost/foo/bar/file.tar.gz
User-Agent: lwp-request/6.15 libwww-perl/6.15
200 OK
Connection: close
eg/server.cgi view on Meta::CPAN
Delete file from server
DELETE http://localhost/mbuserver/foo/bar/file.tar.gz
User-Agent: lwp-request/6.15 libwww-perl/6.15
204 No Content
Connection: close
Date: Tue, 25 Jun 2019 16:51:28 GMT
Server: Apache/2.2.25 (Win32) mod_ssl/2.2.25 OpenSSL/0.9.8y mod_perl/2.0.8 Perl/v5.16.3
Content-Length: 0
Content-Type: text/html; charset=ISO-8859-1
Client-Date: Tue, 25 Jun 2019 16:51:28 GMT
Client-Peer: 127.0.0.1:80
Client-Response-Num: 1
=back
=head1 INTERNAL METHODS
=head2 get_list
eg/server.cgi view on Meta::CPAN
if ($info) {
$path = $info;
} else {
my $i = index($path, BASE_URI_PREFIX);
substr($path, $i, length(BASE_URI_PREFIX), '') if $i > -1;
}
$path = DEFAULT_PATH unless length($path);
my $reqkey = sprintf("%s %s", $meth, $path);
my $root = $ENV{DOCUMENT_ROOT} // getcwd();
if ($reqkey eq 'GET /') { # lwp-request -E "http://localhost/mbuserver"
print $q->header(-type => CONTENT_TYPE, -charset => 'utf-8',);
print get_list($root);
} elsif ($meth eq 'GET') { # lwp-request -E "http://localhost/mbuserver/foo/bar/test.txt"
my $file = File::Spec->catfile($root, $path);
if (-f $file) {
raise("Incorrect path: %s. Check BASE_URI_PREFIX constant first", $ruri) if $ruri eq $path;
print $q->redirect($path);
} elsif (-d $file) {
print $q->header(-type => CONTENT_TYPE, -charset => 'utf-8',);
print get_list($file);
} else {
print $q->header(
-type => CONTENT_TYPE,
-charset => 'utf-8',
-status => '404 Not Found',
);
print "Not Found";
}
} elsif ($meth eq 'HEAD') { # lwp-request -E -m HEAD "http://localhost/mbuserver/foo/bar/test.txt"
my $file = File::Spec->catfile($root, $path);
if (-f $file) {
raise("Incorrect path: %s. Check BASE_URI_PREFIX constant first", $ruri) if $ruri eq $path;
print $q->redirect($path);
} elsif (-d $file) {
my $content = get_list($file);
print $q->header(-type => CONTENT_TYPE, -charset => 'utf-8', -content_length => length($content));
} else {
print $q->header(
-type => CONTENT_TYPE,
-charset => 'utf-8',
-status => '404 Not Found',
);
}
} elsif ($meth eq 'PUT') { # lwp-request -E -m PUT -c "application/octet-stream" "http://localhost/mbuserver/foo/bar/test.txt" < test.txt
# Get filename
my ($volume, $directories, $file) = File::Spec->splitpath( $path );
my $dir = File::Spec->catfile($root, $directories);
unless (-d $dir or -l $dir) {
mkpath( $dir, {verbose => 0} );
}
eg/server.cgi view on Meta::CPAN
} elsif ($meth eq 'DELETE') { # lwp-request -E -m DELETE "http://localhost/mbuserver/foo/bar/test.txt"
my $file = File::Spec->catfile($root, $path);
if (-f $file) {
unlink $file or raise("Could not unlink %s: %s", $file, $!);
print $q->header(
-status => '204 No Content',
);
} elsif (-d $file) {
print $q->header(
-type => CONTENT_TYPE,
-charset => 'utf-8',
-status => '405 Method Not Allowed',
);
print "Method Not Allowed";
} else {
print $q->header(
-type => CONTENT_TYPE,
-charset => 'utf-8',
-status => '404 Not Found',
);
print "Not Found";
}
} else {
print $q->header(
-type => CONTENT_TYPE,
-charset => 'utf-8',
-status => '501 Not Implemented',
);
printf "Not Implemented: %s", $reqkey;
}
sub get_list {
my $r = shift || $root;
my $name = $q->param("name") || $q->param("host");
my @list = ();
find({wanted => sub {
eg/server.cgi view on Meta::CPAN
return if $name && index($_, $name) < 0;
push @list, $_ if -f $_;
}}, $r);
return join "\n", @list;
}
sub raise {
my $format = shift || "Unknown error";
my @err = @_;
print $q->header(
-type => CONTENT_TYPE,
-charset => 'utf-8',
-status => '500 Internal Server Error',
);
printf $format, @err;
exit 0;
}
1;
__END__
lib/App/MBUtiny/Collector/Server.pm view on Meta::CPAN
use HTTP::Date;
use URI;
use App::MBUtiny::Util qw/explain/;
use App::MBUtiny::Collector::DBI;
use CTK::Serializer;
use CTK::ConfGenUtil;
use CTK::TFVals qw/ :ALL /;
use constant {
URL_PATH_PREFIX => "/mbutiny",
CONTENT_TYPE => "application/json; charset=utf-8",
SERIALIZE_FORMAT => 'json',
SR_ATTRS => {
json => [
{ # For serialize
utf8 => 0,
pretty => 1,
allow_nonref => 1,
allow_blessed => 1,
},
{ # For deserialize
lib/App/MBUtiny/Collector/Server.pm view on Meta::CPAN
> GET /mbutiny HTTP/1.1
> Host: localhost
> User-Agent: curl/7.62.0
> Accept: */*
>
< HTTP/1.1 200 OK
< Date: Wed, 19 Jun 2019 10:57:31 GMT
< Server: Apache/2.2.25 (Win32) mod_ssl/2.2.25 OpenSSL/0.9.8y mod_perl/2.0.8 Perl/v5.16.3
< Connection: close
< Content-Length: 214
< Content-Type: application/json; charset=utf-8
<
{
"dsn" : "dbi:SQLite:dbname=/var/lib/mbutiny/mbutiny.db",
"status" : 1,
"name" : "check",
"error" : "",
"method" : "GET",
"path" : "/mbutiny",
"description" : "Check collectors"
}
lib/App/MBUtiny/Collector/Server.pm view on Meta::CPAN
> GET /mbutiny/foo HTTP/1.1
> Host: localhost
> User-Agent: curl/7.58.0
> Accept: */*
>
< HTTP/1.1 200 OK
< Date: Sat, 22 Jun 2019 10:29:26 GMT
< Server: Apache/2.4.29 (Ubuntu)
< Connection: close
< Content-Length: 556
< Content-Type: application/json; charset=utf-8
<
{
"name" : "foo",
"error" : "",
"file" : null,
"status" : 1,
"time" : 0.0073,
"info" : {
"comment" : "Local storages...",
"sha1" : "4200f422b425967ca2cb278cf311edeb74ecdde1",
lib/App/MBUtiny/Collector/Server.pm view on Meta::CPAN
> User-Agent: curl/7.50.1
> Accept: */*
> Content-Type: application/json
> Content-Length: 27
>
< HTTP/1.1 200 OK
< Date: Thu, 20 Jun 2019 15:03:34 GMT
< Server: Apache/2.4.18 (Ubuntu)
< Connection: close
< Content-Length: 27
< Content-Type: text/plain; charset=utf-8
<
=cut
__PACKAGE__->register_method( # POST /mbutiny
name => "add",
method => "POST",
path => $BASE_URL_PATH_PREFIX,
deep => 0,
attrs => {
lib/App/MBUtiny/Collector/Server.pm view on Meta::CPAN
unless ($serializer->status) {
my $errmsg = sprintf("Can't serialize structure: %s", $serializer->error);
$errmsg =~ s/\"/\\\"/g;
$errmsg =~ s/\'/\\\'/g;
$self->data(sprintf('{"status": 0, "error": "%s"}', $errmsg));
$self->code(HTTP_INTERNAL_SERVER_ERROR);
}
#my @res = (sprintf("Status: %s %s", $rc, $msg));
#push @res, sprintf("Content-Type: %s", "text/plain; charset=utf-8");
#push @res, "", $data // "";
#return join("\015\012", @res);
return $self->SUPER::response;
}
sub _get_name_from_path {
my $request_uri = shift // '';
my $uri = new URI(sprintf("http://localhost%s", $request_uri));
my $str = $uri->path() // "";
( run in 0.229 second using v1.01-cache-2.11-cpan-4d50c553e7e )