Linux/NBD/Client.pm

=head1 NAME

Linux::NBD::Client - client (device) side of a network block 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.21;

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 me, bad things will
happen if not.

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 sending 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_timeout ($timeout)

Set the request timeout, in seconds.

=item $client->set_blocksize ($blksize)

Set the device block size in bytes, i.e. how big each block is (must be
>512, <PAGESIZE and a power of two).

Also rounds down the device size to be a multiple of the block size.

=item $client->set_blocks ($nblocks)

Set the device size in block units.

=item $client->set_size ($bytes)

Set the device size in octet units, will be rounded down to be a multiple
of the block size.

=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_timeout {
   my $self = shift;
              
   _set_timeout fileno $self->{device_fd}, $_[0];
}

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];
}

sub print_debug {
   my $self = shift;
              
   _print_debug fileno $self->{device_fd};
}

=item $client->run

Closes all file descriptors except the server socket and 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.

Normally, you should call C<POSIX::_exit> or equivalent when this call
returns.

=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: $!";
   return $self->{pid} if $self->{pid};

   _doit fileno $self->{device_fd}, 1;
   kill 9, 0;
}

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 <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

Revision:	1.11
Committed:	Mon Sep 20 11:14:25 2010 UTC (16 years, 1 month ago) by root
Branch:	MAIN
Changes since 1.10:	+31 -7 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3	root	1.9	Linux::NBD::Client - client (device) side of a network block device
4	root	1.1
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.7	$VERSION = 0.21;
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	root	1.10	=item $client->socket ([$tcp_socket])
49	root	1.1
50			Returns the current socket after setting a new one (if an argument is
51	root	1.10	supplied). The socket I<MUST> be a tcp socket. Believe me, bad things will
52			happen if not.
53	root	1.1
54			The special argument C<undef> will try to clear the socket, if any was
55			set.
56
57	root	1.10	=item $client->device ([$new_device])
58	root	1.1
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	root	1.10	Tries to exit the server by sending a special disconnect message.
131	root	1.1
132			=item $client->clear_queue
133
134			Clears the request queue, if possible. Should be used before setting a new
135			socket.
136
137	root	1.11	=item $client->set_timeout ($timeout)
138
139			Set the request timeout, in seconds.
140
141	root	1.10	=item $client->set_blocksize ($blksize)
142	root	1.1
143	root	1.11	Set the device block size in bytes, i.e. how big each block is (must be
144			>512, <PAGESIZE and a power of two).
145
146			Also rounds down the device size to be a multiple of the block size.
147	root	1.1
148	root	1.11	=item $client->set_blocks ($nblocks)
149	root	1.1
150	root	1.11	Set the device size in block units.
151	root	1.1
152	root	1.11	=item $client->set_size ($bytes)
153	root	1.1
154	root	1.11	Set the device size in octet units, will be rounded down to be a multiple
155			of the block size.
156	root	1.1
157			=cut
158
159			sub disconnect {
160			my $self = shift;
161
162			_disconnect fileno $self->{device_fd};
163			}
164
165			sub clear_queue {
166			my $self = shift;
167
168			_clear_que fileno $self->{device_fd};
169			}
170
171	root	1.11	sub set_timeout {
172			my $self = shift;
173
174			_set_timeout fileno $self->{device_fd}, $_[0];
175			}
176
177	root	1.1	sub set_blocksize {
178			my $self = shift;
179
180			_set_blksize fileno $self->{device_fd}, $_[0];
181			}
182
183			sub set_size {
184			my $self = shift;
185
186			_set_size fileno $self->{device_fd}, $_[0];
187			}
188
189			sub set_blocks {
190			my $self = shift;
191
192			_set_size_blocks fileno $self->{device_fd}, $_[0];
193			}
194
195	root	1.11	sub print_debug {
196			my $self = shift;
197
198			_print_debug fileno $self->{device_fd};
199			}
200
201	root	1.1	=item $client->run
202
203	root	1.11	Closes all file descriptors except the server socket and enters
204			the service loop (waits for read/write requests on the device and
205	root	1.10	forwards them over the given socket). Only returns when somebody calls
206			C<disconnect> or the server is killed.
207	root	1.1
208	root	1.11	Normally, you should call C<POSIX::_exit> or equivalent when this call
209			returns.
210
211	root	1.1	=item $pid = $client->run_async
212
213			Runs the service loop asynchronously and returns the pid of the newly
214			created service process.
215
216			=item $client->kill_async
217
218	root	1.2	Kills any running async service. Please note that this also kills the
219			socket, so you need to re-set the socket after this call.
220	root	1.1
221			=cut
222
223			sub run {
224			my $self = shift;
225	root	1.11
226	root	1.1	_doit fileno $self->{device_fd};
227			}
228
229			sub run_async {
230			my $self = shift;
231
232			$self->{pid} = fork;
233	root	1.10
234	root	1.1	defined $self->{pid} or croak "fork: $!";
235	root	1.10	return $self->{pid} if $self->{pid};
236	root	1.1
237	root	1.10	_doit fileno $self->{device_fd}, 1;
238			kill 9, 0;
239	root	1.1	}
240
241			sub kill_async {
242			my $self = shift;
243
244			if (my $pid = delete $self->{pid}) {
245	root	1.3	#_clear_que fileno $self->{device_fd};
246			#_disconnect fileno $self->{device_fd};
247			#_clear_sock fileno $self->{device_fd};
248	root	1.5	# just kill -9 it, seems to be safest (all other ways just oops sooner or later)
249			kill 9, $pid;
250	root	1.1	}
251			}
252
253			sub DESTROY {
254			my $self = shift;
255
256			$self->kill_async;
257			}
258
259			=cut
260
261			1;
262
263			=back
264
265			=head1 AUTHOR
266
267	root	1.8	Marc Lehmann <schmorp@schmorp.de>
268			http://home.schmorp.de/
269	root	1.1
270			=cut
271