Linux/NBD/Client.pm

=head1 NAME

Linux::NBD::Client - client (device) side of a network blokc device

=head1 SYNOPSIS

 use Linux::NBD::Client;

=head1 DESCRIPTION

WARNING: I talked to the author of the nbd driver because nbd is so
extremely racy (right now, stopping it often causes oopses, a server
crashing also often oopses etc..).

It turned out that he doesn't care at all and nbd is basically
unmaintained, so YMMV when using this module, especially when writing
servers.

He really should have said that on his nbd pages ;[.

OTOH, it works relatively reliable when you don't stop the servers, so
watch out and keep your fingers crossed.

=head1 METHODS

=over 4

=cut

package Linux::NBD::Client;

$VERSION = 0.2;

use Linux::NBD ();

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

=item $client = new Linux::NBD::Client [socket => $fh][, device => "/dev/ndx"], ...

Create a new client.

Unless C<device> is given, an unused device node is looked up using the
C<device> method (this might result in an exception!).

The other arguments correspond to calls to methods of the same name.

=item $client->socket([$tcp_socket])

Returns the current socket after setting a new one (if an argument is
supplied). The socket I<MUST> be a tcp socket. Believe, bad things will
happen.

The special argument C<undef> will try to clear the socket, if any was
set.

=item $client->device([$new_device])

Returns the current device node (e.g. C</dev/nd2>) after setting a new one if
an argument is supplied.

If the argument is C<undef> it will search for an unallocated nbd-device
and use it.

=cut

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

   $self->device (exists $self->{device} ? $self->{device} : undef);
   exists $self->{socket} and $self->socket($self->{socket});
   
   $self;
}

sub socket {
   my $self = shift;

   if (@_) {
      $self->{socket} = $_[0];

      if (defined $self->{socket}) {
         my $fileno = $_[0] =~ /[^0-9]/ ? fileno $_[0] : $_[0];
         _set_sock fileno $self->{device_fd}, $fileno;
      } else {
         _clear_sock fileno $self->{device_fd};
      }
   }

   $self->{socket};
}

sub device {
   my $self = shift;

   if (@_) {
      my $device = shift;

      if (defined $device) {
         open my $dev, "+<$device" or croak "$device: $!";
         $self->{device} = $device;
         $self->{device_fd} = $dev;
      } else {
        for (0..256) {
           $_ < 256 or croak "unable to find an available nbd device";

           my $path = "/dev/nd$_";
           -e $path or system "mknod", $path, "b", 43, $_;
           open my $dev, "+<$path" or croak "$device: $!";
           _set_sock fileno $dev, -1;
           if ($!{EINVAL}) {
              $self->{device} = $path;
              $self->{device_fd} = $dev;
              last;
           } elsif ($!{EBUSY}) {
              next;
           } else {
              croak "$path: $!";
           }
        }
      }
   }

   $self->{device};
}

=item $client->disconnect

Tries to exit the server by ending a special disconnect message.

=item $client->clear_queue

Clears the request queue, if possible. Should be used before setting a new
socket.

=item $client->set_blocksize($blksize)

Set the device blocksize in bytes (must be >512, <PAGESIZE and a power of
two).

=item $client->set_size($bytes)

Set the device size in bytes.

=item $client->set_blocks($nblocks)

Set the size in blocks.

=cut

sub disconnect {
   my $self = shift;

   _disconnect fileno $self->{device_fd};
}

sub clear_queue {
   my $self = shift;

   _clear_que fileno $self->{device_fd};
}

sub set_blocksize {
   my $self = shift;
              
   _set_blksize fileno $self->{device_fd}, $_[0];
}

sub set_size {
   my $self = shift;
              
   _set_size fileno $self->{device_fd}, $_[0];
}

sub set_blocks {
   my $self = shift;
              
   _set_size_blocks fileno $self->{device_fd}, $_[0];
}

=item $client->run

Enters the service loop (waits for read/write requests on the device and
forwards them over the given socket). Only returns when somebody calls C<disconnect>
or the server is killed.

=item $pid = $client->run_async

Runs the service loop asynchronously and returns the pid of the newly
created service process.

=item $client->kill_async

Kills any running async service. Please note that this also kills the
socket, so you need to re-set the socket after this call.

=cut

sub run {
   my $self = shift;
   _doit fileno $self->{device_fd};
}

sub run_async {
   my $self = shift;

   $self->{pid} = fork;
   defined $self->{pid} or croak "fork: $!";

   $self->{pid} or _doit fileno $self->{device_fd}, 1;

   $self->{pid};
}

sub kill_async {
   my $self = shift;

   if (my $pid = delete $self->{pid}) {
      #_clear_que fileno $self->{device_fd};
      #_disconnect fileno $self->{device_fd};
      #_clear_sock fileno $self->{device_fd};
      # just kill -9 it, seems to be safest (all other ways just oops sooner or later)
      kill 9, $pid;
   }
}

sub DESTROY {
   my $self = shift;

   $self->kill_async;
}

=cut

1;

=back

=head1 AUTHOR

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

=cut

Revision:	1.6
Committed:	Fri Jun 6 08:26:57 2003 UTC (23 years, 4 months ago) by root
Branch:	MAIN
Changes since 1.5:	+1 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Linux::NBD::Client - client (device) side of a network blokc device
4
5			=head1 SYNOPSIS
6
7			use Linux::NBD::Client;
8
9			=head1 DESCRIPTION
10
11	root	1.4	WARNING: I talked to the author of the nbd driver because nbd is so
12			extremely racy (right now, stopping it often causes oopses, a server
13			crashing also often oopses etc..).
14
15			It turned out that he doesn't care at all and nbd is basically
16			unmaintained, so YMMV when using this module, especially when writing
17			servers.
18
19			He really should have said that on his nbd pages ;[.
20
21			OTOH, it works relatively reliable when you don't stop the servers, so
22			watch out and keep your fingers crossed.
23	root	1.1
24			=head1 METHODS
25
26			=over 4
27
28			=cut
29
30			package Linux::NBD::Client;
31
32	root	1.5	$VERSION = 0.2;
33	root	1.1
34			use Linux::NBD ();
35
36			use Carp qw(croak);
37			use Errno ();
38
39			=item $client = new Linux::NBD::Client [socket => $fh][, device => "/dev/ndx"], ...
40
41			Create a new client.
42
43			Unless C<device> is given, an unused device node is looked up using the
44			C<device> method (this might result in an exception!).
45
46			The other arguments correspond to calls to methods of the same name.
47
48			=item $client->socket([$tcp_socket])
49
50			Returns the current socket after setting a new one (if an argument is
51			supplied). The socket I<MUST> be a tcp socket. Believe, bad things will
52			happen.
53
54			The special argument C<undef> will try to clear the socket, if any was
55			set.
56
57			=item $client->device([$new_device])
58
59			Returns the current device node (e.g. C</dev/nd2>) after setting a new one if
60			an argument is supplied.
61
62			If the argument is C<undef> it will search for an unallocated nbd-device
63			and use it.
64
65			=cut
66
67			sub new {
68			my $class = shift;
69			my $self = bless { @_ }, $class;
70
71			$self->device (exists $self->{device} ? $self->{device} : undef);
72			exists $self->{socket} and $self->socket($self->{socket});
73
74			$self;
75			}
76
77			sub socket {
78			my $self = shift;
79
80			if (@_) {
81			$self->{socket} = $_[0];
82
83			if (defined $self->{socket}) {
84			my $fileno = $_[0] =~ /[^0-9]/ ? fileno $_[0] : $_[0];
85			_set_sock fileno $self->{device_fd}, $fileno;
86			} else {
87			_clear_sock fileno $self->{device_fd};
88			}
89			}
90
91			$self->{socket};
92			}
93
94			sub device {
95			my $self = shift;
96
97			if (@_) {
98			my $device = shift;
99
100			if (defined $device) {
101			open my $dev, "+<$device" or croak "$device: $!";
102			$self->{device} = $device;
103			$self->{device_fd} = $dev;
104			} else {
105			for (0..256) {
106			$_ < 256 or croak "unable to find an available nbd device";
107
108			my $path = "/dev/nd$_";
109	root	1.6	-e $path or system "mknod", $path, "b", 43, $_;
110	root	1.1	open my $dev, "+<$path" or croak "$device: $!";
111			_set_sock fileno $dev, -1;
112			if ($!{EINVAL}) {
113			$self->{device} = $path;
114			$self->{device_fd} = $dev;
115			last;
116			} elsif ($!{EBUSY}) {
117			next;
118			} else {
119			croak "$path: $!";
120			}
121			}
122			}
123			}
124
125			$self->{device};
126			}
127
128			=item $client->disconnect
129
130			Tries to exit the server by ending a special disconnect message.
131
132			=item $client->clear_queue
133
134			Clears the request queue, if possible. Should be used before setting a new
135			socket.
136
137			=item $client->set_blocksize($blksize)
138
139			Set the device blocksize in bytes (must be >512, <PAGESIZE and a power of
140			two).
141
142			=item $client->set_size($bytes)
143
144			Set the device size in bytes.
145
146			=item $client->set_blocks($nblocks)
147
148			Set the size in blocks.
149
150			=cut
151
152			sub disconnect {
153			my $self = shift;
154
155			_disconnect fileno $self->{device_fd};
156			}
157
158			sub clear_queue {
159			my $self = shift;
160
161			_clear_que fileno $self->{device_fd};
162			}
163
164			sub set_blocksize {
165			my $self = shift;
166
167			_set_blksize fileno $self->{device_fd}, $_[0];
168			}
169
170			sub set_size {
171			my $self = shift;
172
173			_set_size fileno $self->{device_fd}, $_[0];
174			}
175
176			sub set_blocks {
177			my $self = shift;
178
179			_set_size_blocks fileno $self->{device_fd}, $_[0];
180			}
181
182			=item $client->run
183
184			Enters the service loop (waits for read/write requests on the device and
185			forwards them over the given socket). Only returns when somebody calls C<disconnect>
186			or the server is killed.
187
188			=item $pid = $client->run_async
189
190			Runs the service loop asynchronously and returns the pid of the newly
191			created service process.
192
193			=item $client->kill_async
194
195	root	1.2	Kills any running async service. Please note that this also kills the
196			socket, so you need to re-set the socket after this call.
197	root	1.1
198			=cut
199
200			sub run {
201			my $self = shift;
202			_doit fileno $self->{device_fd};
203			}
204
205			sub run_async {
206			my $self = shift;
207
208			$self->{pid} = fork;
209			defined $self->{pid} or croak "fork: $!";
210
211			$self->{pid} or _doit fileno $self->{device_fd}, 1;
212
213			$self->{pid};
214			}
215
216			sub kill_async {
217			my $self = shift;
218
219			if (my $pid = delete $self->{pid}) {
220	root	1.3	#_clear_que fileno $self->{device_fd};
221			#_disconnect fileno $self->{device_fd};
222			#_clear_sock fileno $self->{device_fd};
223	root	1.5	# just kill -9 it, seems to be safest (all other ways just oops sooner or later)
224			kill 9, $pid;
225	root	1.1	}
226			}
227
228			sub DESTROY {
229			my $self = shift;
230
231			$self->kill_async;
232			}
233
234			=cut
235
236			1;
237
238			=back
239
240			=head1 AUTHOR
241
242			Marc Lehmann <pcg@goof.com>
243			http://www.goof.com/pcg/marc/
244
245			=cut
246