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

Ehrm.

=head1 METHODS

=over 4

=cut

package Linux::NBD::Client;

$VERSION = 0.1;

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

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