Linux/NBD/Server.pm

=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 readbaility 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 no
further requests will arrive.

=item $server->format_reply ($handle[, $error, [, $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.

If C<$data> is given and C<$error> is zero, it is appended to the string
before it is returned.

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

Formats and sends a reply to the server.

=item $server->send ($data)

Writes the given data to the client socket.

=item $server->recv ($bytes)

Reads the specified number of bytes and returns them.

=cut

sub run {
   my $self = shift;

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

sub one_request {
   my $self = shift;

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

sub format_reply {
   shift;
   &_format_reply;
}

sub reply {
   my $self = shift;

   $self->send(&_format_reply);
}

sub send {
   syswrite $_[0]->{socket}, $_[1];
}

sub recv {
   my ($self, $len) = @_;

   my ($buf, $todo);

   sysread $self->{socket}, $buf, $togo, length $buf
         or die "error or eof while receiving from network: $!"
      while $todo = $len - length $buf;

   $buf
}

=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.:

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

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

Same as C<req_read>, but you should use C<recv> to read C<$len> bytes from
the socket (even if you intend to return an error, of course).

  my ($self, $handle, $ofs, $len) = @_;
  my $data = $self->recv($len);
  $self->reply($handle);

=cut

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

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

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

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

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 BUGS

Should support AnyEvent or something similar for non-blocking behaviour.

=head1 AUTHOR

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

=cut

Revision:	1.8
Committed:	Mon Sep 20 10:31:47 2010 UTC (16 years ago) by root
Branch:	MAIN
Changes since 1.7:	+5 -4 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Linux::NBD::Server - server (data provider) side of a network block device
4
5			=head1 SYNOPSIS
6
7			use Linux::NBD::Server;
8
9			=head1 DESCRIPTION
10
11			You must subclass C<Linux::NBD::Server> to get meaningful results. You
12			should overwrite C<req_read> and/or C<req_write>. The default
13			implementations just return EIO.
14
15			=head1 METHODS
16
17			=over 4
18
19			=cut
20
21			package Linux::NBD::Server;
22
23	root	1.4	$VERSION = 0.21;
24	root	1.1
25			use Linux::NBD ();
26
27			use Carp qw(croak);
28			use Errno ();
29
30	root	1.8	=item $server = new Linux::NBD::Server socket => $fh, ...;
31	root	1.1
32			Create a new server. All arguments are put into a hashref which is blessed
33			and returned. The only required argument is C<socket> which should be
34			connected to a C<Linux::NBD::Client>.
35
36			=cut
37
38			sub new {
39			my $class = shift;
40			bless { @_ }, ref $class \|\| $class;
41			}
42
43			=item $server->run
44
45			Enters a server loop, serving requests. Only returns when the socket is closed
46			or a disconnect message is received.
47
48	root	1.8	If you need non-blocking access your best bet is to use C<<
49			$server->one_request >> after you detected readbaility on the file
50			descriptor, but note that it still might block to read the write data from
51			the socket.
52	root	1.1
53			=item $server->one_request
54
55			Waits for and handles a single request and returns, returning true if no
56			further requests will arrive.
57
58			=item $server->format_reply ($handle[, $error, [, $data]])
59
60			Formats (and returns as a string) a reply message. If the request was a
61			read request and C<$error> is zero (or missing, both meaning no error),
62			you should append the read data to it.
63
64			If C<$data> is given and C<$error> is zero, it is appended to the string
65			before it is returned.
66
67			=item $server->reply ($handle[, $error[, $data]])
68
69			Formats and sends a reply to the server.
70
71			=item $server->send ($data)
72
73			Writes the given data to the client socket.
74
75	root	1.6	=item $server->recv ($bytes)
76	root	1.1
77			Reads the specified number of bytes and returns them.
78
79			=cut
80
81			sub run {
82			my $self = shift;
83
84			1 while not _one_request $self, fileno $self->{socket};
85			}
86
87			sub one_request {
88			my $self = shift;
89
90			_one_request $self, fileno $self->{socket};
91			}
92
93			sub format_reply {
94			shift;
95			&_format_reply;
96			}
97
98			sub reply {
99			my $self = shift;
100
101			$self->send(&_format_reply);
102			}
103
104			sub send {
105			syswrite $_[0]->{socket}, $_[1];
106			}
107
108			sub recv {
109	root	1.6	my ($self, $len) = @_;
110	root	1.1
111	root	1.6	my ($buf, $todo);
112
113			sysread $self->{socket}, $buf, $togo, length $buf
114	root	1.7	or die "error or eof while receiving from network: $!"
115	root	1.6	while $todo = $len - length $buf;
116
117			$buf
118	root	1.1	}
119
120	root	1.6	=item $server->req_read ($handle, $offset, $length)
121	root	1.1
122			This callback is called for every read request. It should send
123	root	1.6	back a reply and the requested number of bytes, e.g.:
124	root	1.1
125			my ($self, $handle, $ofs, $len) = @_;
126			$self->reply($handle, 0, "\xff" x $len);
127
128	root	1.6	=item $server->req_write ($handle, $offset, $length)
129	root	1.1
130			Same as C<req_read>, but you should use C<recv> to read C<$len> bytes from
131			the socket (even if you intend to return an error, of course).
132
133			my ($self, $handle, $ofs, $len) = @_;
134			my $data = $self->recv($len);
135			$self->reply($handle);
136
137			=cut
138
139			sub req_read {
140			my ($self, $handle, $ofs, $len) = @_;
141
142	root	1.6	$self->reply ($handle, 1);
143	root	1.1	}
144
145			sub req_write {
146			my ($self, $handle, $ofs, $len) = @_;
147
148	root	1.6	$self->recv ($len);
149			$self->reply ($handle, 1);
150	root	1.1	}
151
152			1;
153
154			=back
155
156	root	1.6	=head1 NBD TOOL NEGOTIATION PROTOCOL
157
158			Standard NBD tools add a handshake phase before starting to serve/send
159			requests. The server-side implementation looks like this:
160
161			$size = new Math::BigInt $size;
162			my $size_hi = $size->copy->brsft(32)->blsft(32);
163			my $size_lo = $size->copy->bsub($size_hi)->numify;
164			$size_hi = $size_hi->brsft(32)->numify;
165
166			$s->send ("NBDMAGIC\x00\x00\x42\x02\x81\x86\x12\x53");
167			$s->send (pack "NN", $size_hi, $size_lo);
168			$s->send ("\x00" x 128);
169
170			# now serve
171			my $server = new ServerClass socket => $s;
172			$server->run;
173
174
175			=head1 BUGS
176
177			Should support AnyEvent or something similar for non-blocking behaviour.
178
179	root	1.1	=head1 AUTHOR
180
181	root	1.5	Marc Lehmann <schmorp@schmorp.de>
182			http://home.schmorp.de/
183	root	1.1
184			=cut
185