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.1;

use Linux::NBD ();

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

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

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>, 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 {
   $_[1] == sysread $_[0]->{socket}, (my $buf), $_[1]
      or die "error while receiving from network: $!";

   $buf;
}

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

This callback is called for every read request. It should send
back a reply and the requestes 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, Errno::EIO);
}

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

   $self->recv($len);
   $self->reply($handle, Errno::EIO);
}

1;

=back

=head1 AUTHOR

 Marc Lehmann <pcg@goof.com>
 http://www.goof.com/pcg/marc/

=cut

Revision:	1.1
Committed:	Thu May 8 23:43:44 2003 UTC (23 years, 5 months ago) by root
Branch:	MAIN
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			$VERSION = 0.1;
24
25			use Linux::NBD ();
26
27			use Carp qw(croak);
28			use Errno ();
29
30			=item $server = new Linux::NBD::Server socket => $fd, ...;
31
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			If you need non-blocking access your best bet is to use
49			C<$server->one_request>, but note that it still might block to read the
50			write data from the socket.
51
52			=item $server->one_request
53
54			Waits for and handles a single request and returns, returning true if no
55			further requests will arrive.
56
57			=item $server->format_reply ($handle[, $error, [, $data]])
58
59			Formats (and returns as a string) a reply message. If the request was a
60			read request and C<$error> is zero (or missing, both meaning no error),
61			you should append the read data to it.
62
63			If C<$data> is given and C<$error> is zero, it is appended to the string
64			before it is returned.
65
66			=item $server->reply ($handle[, $error[, $data]])
67
68			Formats and sends a reply to the server.
69
70			=item $server->send ($data)
71
72			Writes the given data to the client socket.
73
74			=item $server->recv($bytes)
75
76			Reads the specified number of bytes and returns them.
77
78			=cut
79
80			sub run {
81			my $self = shift;
82
83			1 while not _one_request $self, fileno $self->{socket};
84			}
85
86			sub one_request {
87			my $self = shift;
88
89			_one_request $self, fileno $self->{socket};
90			}
91
92			sub format_reply {
93			shift;
94			&_format_reply;
95			}
96
97			sub reply {
98			my $self = shift;
99
100			$self->send(&_format_reply);
101			}
102
103			sub send {
104			syswrite $_[0]->{socket}, $_[1];
105			}
106
107			sub recv {
108			$_[1] == sysread $_[0]->{socket}, (my $buf), $_[1]
109			or die "error while receiving from network: $!";
110
111			$buf;
112			}
113
114			=item $server->req_read($handle, $offset, $length)
115
116			This callback is called for every read request. It should send
117			back a reply and the requestes number of bytes, e.g.:
118
119			my ($self, $handle, $ofs, $len) = @_;
120			$self->reply($handle, 0, "\xff" x $len);
121
122			=item $server->req_write($handle, $offset, $length)
123
124			Same as C<req_read>, but you should use C<recv> to read C<$len> bytes from
125			the socket (even if you intend to return an error, of course).
126
127			my ($self, $handle, $ofs, $len) = @_;
128			my $data = $self->recv($len);
129			$self->reply($handle);
130
131			=cut
132
133			sub req_read {
134			my ($self, $handle, $ofs, $len) = @_;
135
136			$self->reply($handle, Errno::EIO);
137			}
138
139			sub req_write {
140			my ($self, $handle, $ofs, $len) = @_;
141
142			$self->recv($len);
143			$self->reply($handle, Errno::EIO);
144			}
145
146			1;
147
148			=back
149
150			=head1 AUTHOR
151
152			Marc Lehmann <pcg@goof.com>
153			http://www.goof.com/pcg/marc/
154
155			=cut
156