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/nbdX"], ...

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!).

=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/nbd2>) 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/nbd$_";
           -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.

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

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.12
Committed:	Tue Sep 21 11:31:05 2010 UTC (16 years ago) by root
Branch:	MAIN
Changes since 1.11:	+4 -10 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	root	1.12	=item $client = new Linux::NBD::Client [socket => $fh][, device => "/dev/nbdX"], ...
40	root	1.1
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	root	1.10	=item $client->socket ([$tcp_socket])
47	root	1.1
48			Returns the current socket after setting a new one (if an argument is
49	root	1.10	supplied). The socket I<MUST> be a tcp socket. Believe me, bad things will
50			happen if not.
51	root	1.1
52			The special argument C<undef> will try to clear the socket, if any was
53			set.
54
55	root	1.10	=item $client->device ([$new_device])
56	root	1.1
57	root	1.12	Returns the current device node (e.g. C</dev/nbd2>) after setting a new one if
58	root	1.1	an argument is supplied.
59
60			If the argument is C<undef> it will search for an unallocated nbd-device
61			and use it.
62
63			=cut
64
65			sub new {
66			my $class = shift;
67			my $self = bless { @_ }, $class;
68
69			$self->device (exists $self->{device} ? $self->{device} : undef);
70	root	1.12	exists $self->{socket} and $self->socket ($self->{socket});
71	root	1.1
72			$self;
73			}
74
75			sub socket {
76			my $self = shift;
77
78			if (@_) {
79			$self->{socket} = $_[0];
80
81			if (defined $self->{socket}) {
82			my $fileno = $_[0] =~ /[^0-9]/ ? fileno $_[0] : $_[0];
83			_set_sock fileno $self->{device_fd}, $fileno;
84			} else {
85			_clear_sock fileno $self->{device_fd};
86			}
87			}
88
89			$self->{socket};
90			}
91
92			sub device {
93			my $self = shift;
94
95			if (@_) {
96			my $device = shift;
97
98			if (defined $device) {
99			open my $dev, "+<$device" or croak "$device: $!";
100			$self->{device} = $device;
101			$self->{device_fd} = $dev;
102			} else {
103			for (0..256) {
104			$_ < 256 or croak "unable to find an available nbd device";
105
106	root	1.12	my $path = "/dev/nbd$_";
107	root	1.6	-e $path or system "mknod", $path, "b", 43, $_;
108	root	1.1	open my $dev, "+<$path" or croak "$device: $!";
109			_set_sock fileno $dev, -1;
110			if ($!{EINVAL}) {
111			$self->{device} = $path;
112			$self->{device_fd} = $dev;
113			last;
114			} elsif ($!{EBUSY}) {
115			next;
116			} else {
117			croak "$path: $!";
118			}
119			}
120			}
121			}
122
123			$self->{device};
124			}
125
126			=item $client->disconnect
127
128	root	1.10	Tries to exit the server by sending a special disconnect message.
129	root	1.1
130			=item $client->clear_queue
131
132			Clears the request queue, if possible. Should be used before setting a new
133			socket.
134
135	root	1.11	=item $client->set_timeout ($timeout)
136
137			Set the request timeout, in seconds.
138
139	root	1.10	=item $client->set_blocksize ($blksize)
140	root	1.1
141	root	1.11	Set the device block size in bytes, i.e. how big each block is (must be
142			>512, <PAGESIZE and a power of two).
143
144			Also rounds down the device size to be a multiple of the block size.
145	root	1.1
146	root	1.11	=item $client->set_blocks ($nblocks)
147	root	1.1
148	root	1.11	Set the device size in block units.
149	root	1.1
150	root	1.11	=item $client->set_size ($bytes)
151	root	1.1
152	root	1.11	Set the device size in octet units, will be rounded down to be a multiple
153			of the block size.
154	root	1.1
155			=cut
156
157			sub disconnect {
158			my $self = shift;
159
160			_disconnect fileno $self->{device_fd};
161			}
162
163			sub clear_queue {
164			my $self = shift;
165
166			_clear_que fileno $self->{device_fd};
167			}
168
169	root	1.11	sub set_timeout {
170			my $self = shift;
171
172			_set_timeout fileno $self->{device_fd}, $_[0];
173			}
174
175	root	1.1	sub set_blocksize {
176			my $self = shift;
177
178			_set_blksize fileno $self->{device_fd}, $_[0];
179			}
180
181			sub set_size {
182			my $self = shift;
183
184			_set_size fileno $self->{device_fd}, $_[0];
185			}
186
187			sub set_blocks {
188			my $self = shift;
189
190			_set_size_blocks fileno $self->{device_fd}, $_[0];
191			}
192
193	root	1.11	sub print_debug {
194			my $self = shift;
195
196			_print_debug fileno $self->{device_fd};
197			}
198
199	root	1.1	=item $client->run
200
201	root	1.11	Closes all file descriptors except the server socket and enters
202			the service loop (waits for read/write requests on the device and
203	root	1.10	forwards them over the given socket). Only returns when somebody calls
204			C<disconnect> or the server is killed.
205	root	1.1
206			=item $pid = $client->run_async
207
208			Runs the service loop asynchronously and returns the pid of the newly
209			created service process.
210
211			=item $client->kill_async
212
213	root	1.2	Kills any running async service. Please note that this also kills the
214			socket, so you need to re-set the socket after this call.
215	root	1.1
216			=cut
217
218			sub run {
219			my $self = shift;
220	root	1.11
221	root	1.1	_doit fileno $self->{device_fd};
222			}
223
224			sub run_async {
225			my $self = shift;
226
227			$self->{pid} = fork;
228	root	1.10
229	root	1.1	defined $self->{pid} or croak "fork: $!";
230	root	1.10	return $self->{pid} if $self->{pid};
231	root	1.1
232	root	1.10	_doit fileno $self->{device_fd}, 1;
233	root	1.1	}
234
235			sub kill_async {
236			my $self = shift;
237
238			if (my $pid = delete $self->{pid}) {
239	root	1.3	#_clear_que fileno $self->{device_fd};
240			#_disconnect fileno $self->{device_fd};
241			#_clear_sock fileno $self->{device_fd};
242	root	1.5	# just kill -9 it, seems to be safest (all other ways just oops sooner or later)
243			kill 9, $pid;
244	root	1.1	}
245			}
246
247			sub DESTROY {
248			my $self = shift;
249
250			$self->kill_async;
251			}
252
253			=cut
254
255			1;
256
257			=back
258
259			=head1 AUTHOR
260
261	root	1.8	Marc Lehmann <schmorp@schmorp.de>
262			http://home.schmorp.de/
263	root	1.1
264			=cut
265