=head1 NAME

Linux::NBD::Server - server (data provider) side of a network block device

=head1 SYNOPSIS

 use Linux::NBD::Server;

=head1 DESCRIPTION

You must subclass C<Linux::NBD::Server> to get meaningful results. You
should overwrite C<req_read> and/or C<req_write>. The default
implementations just return EIO.

=head1 METHODS

=over 4

=cut

package Linux::NBD::Server;

$VERSION = 0.21;

use Linux::NBD ();

use Carp qw(croak);
use Errno ();

=item $server = new Linux::NBD::Server socket => $fh, ...;

Create a new server. All arguments are put into a hashref which is blessed
and returned. The only required argument is C<socket> which should be
connected to a C<Linux::NBD::Client>.

=cut

sub new {
   my $class = shift;
   bless { @_ }, ref $class || $class;
}

=item $server->run

Enters a server loop, serving requests. Only returns when the socket is closed
or a disconnect message is received.

If you need non-blocking access your best bet is to use C<<
$server->one_request >> after you detected readability on the file
descriptor, but note that it still might block to read the write data from
the socket.

=item $server->one_request

Waits for and handles a single request and returns, returning true if a
request could be handled, false (but defined) if no full request could be
received yet (in which case the partial request will be buffered), and
C<undef> if there was an error or eof.

On blockign sockets, this will read one full request and handle it. On
non-blocking sockets it will try to do the same, but if not enough data is
available, it will return false (but defined) and buffer th already-read
data for the next invocation.

=item $server->format_reply ($handle[, $error, [, $read_data]])

Formats (and returns as a string) a reply message. If the request was a
read request and C<$error> is zero (or missing, both meaning no error),
you should append the read data to it (or let the method do it by
specifying the C<$read_data> argument, which is automatically appended
unless C<$error> is true).

=item $server->reply ($handle[, $error[, $read_data]])

Formats and sends a reply to the server. Only works on blocking
sockets. For non-blocking sockets, you have to use C<format_reply> and
manage the send buffer yourself.

=cut

sub run {
   my $self = shift;

   1 while defined _one_request $self, fileno $self->{socket};
}

sub one_request {
   my $self = shift;

   _one_request $self, fileno $self->{socket}
}

sub reply {
   $_[0]->_send (&format_reply)
}

#TODO: does not work on non-blocking sockets
sub _send {
   syswrite $_[0]->{socket}, $_[1]
}

=item $server->req_read ($handle, $offset, $length)

This callback is called for every read request. It should send
back a reply and the requested number of bytes, e.g.:

  sub req_read {
     my ($self, $handle, $ofs, $len) = @_;
     $self->reply ($handle, 0, "\xff" x $len);
  }

The default implementation will reply with an error.

=item $server->req_write ($handle, $offset, $data)

Same as C<req_read>, but is called for writes: instead of a length the
write data is passed directly.

  sub req_write {
     my ($self, $handle, $ofs, $data) = @_;
     $self->reply ($handle, 0); # OK
  }

You can avoid copying the (potentially large) data argument by refering to
it directly, e.g.:

  sub req_write {
     my ($self, $handle, $ofs) = @_;
     # do something with $_[3] directly
     $self->reply ($handle, 0); # OK
  }

The default implementation will reply with an error.

=item $server->req_disc

A disconnect request was received - what you do with it is up to you, the
kernel driver is a bit confused - you can still have outstanding requests,
and you can still receive further requests, so it's not clear what this
request is intended to achieve, and it's probably best not to override it.

=cut

# =item $server->req_error
# 
# A read or write error occured, you can look at C<$!> to see what it is
# about, or simply ignore it. In all cases this error is fatal, i.e. no
# further request will be handled.
# 
# =item $server->req_eof
# 
# The socket
# 
# =cut

sub req_read {
   my ($self, $handle, $ofs, $len) = @_;

   $self->reply ($handle, 1);
}

sub req_write {
   my ($self, $handle, $ofs, $data) = @_;

   $self->reply ($handle, 1);
}

sub req_disc {
   # nop
}

1;

=back

=head1 NBD TOOL NEGOTIATION PROTOCOL

Standard NBD tools add a handshake phase before starting to serve/send
requests. The server-side implementation looks like this:

    $size = new Math::BigInt $size;
    my $size_hi = $size->copy->brsft(32)->blsft(32);
    my $size_lo = $size->copy->bsub($size_hi)->numify;
    $size_hi = $size_hi->brsft(32)->numify;

    $s->send ("NBDMAGIC\x00\x00\x42\x02\x81\x86\x12\x53");
    $s->send (pack "NN", $size_hi, $size_lo);
    $s->send ("\x00" x 128);

    # now serve
    my $server = new ServerClass socket => $s;
    $server->run;

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut