Subversion Repositories Spectranet

[/] [trunk/] [tnfs/] [tnfs-perl/] [tnfsd.pl] - Blame information for rev 255

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 182 winston
#!/usr/bin/perl
2
#
3
# A Perl TNFS server that should work on any operating system with a perl
4
# interpreter. It will run out the box on Linux, most BSDs and Mac OSX since
5
# these come with perl interpreters.
6
#
7
# Windows requires ActiveState Perl or Cygwin Perl.
8
#
9
# At the present time this is just a simple server allowing anonymous TNFS
10
# mounts. Its main purpose at present is for testing 8 bit clients and
11
# helping in protocol development.
12
#
13
# Usage: tnfsd <path to export>
14
 
15
use IO::Socket::INET;
16
use IO::Select;
17
use FileHandle;
18 183 winston
use Data::Dumper;
19 188 winston
use Fcntl;
20 182 winston
use strict;
21
 
22
my $MAXSIZE=1024;       # largest TNFS datagram
23
 
24
my $root=shift();
25
if(!$root)
26
{
27
        print("Usage: tnfsd.pl <root directory>\n");
28
        exit(255);
29
}
30
 
31
# Define which TNFS command IDs should go to what functions.
32 183 winston
my %TNFSCMDS=(  0x00    => \&mount,
33 185 winston
                0x01    => \&umount,
34
                0x10    => \&opendir,
35
                0x11    => \&readdir,
36 188 winston
                0x12    => \&closedir,
37
                0x20    => \&openFile,
38
                0x21    => \&readBlock,
39
                0x22    => \&writeBlock,
40 197 winston
                0x23    => \&closeFile,
41 200 winston
                0x24    => \&statFile,
42
                0x25    => \&seekFile,
43
                0x26    => \&unlinkFile,
44
                0x27    => \&chmodFile );
45 182 winston
 
46 188 winston
# File modes
47
my %MODE=(      0x01    => O_RDONLY,
48
                0x02    => O_WRONLY,
49
                0x03    => O_RDWR );
50
 
51 182 winston
# Sessions - clients that have mounted us
52
my %SESSION;            # Table of session ids to IP addresses
53
my %LASTMSG;            # Table of last messages for a session
54
my %MOUNTPOINT;         # Table of mount points for sessions
55 185 winston
my %DIRHANDLE;          # Table of directory handles
56
my %FILEHANDLE;         # Table of file handles
57 201 winston
my %SEQNO;              # Table of sequence numbers
58 182 winston
 
59
# Main program. Create the socket and listen for requests.
60
my $sock=IO::Socket::INET->new(LocalPort        => 16384,
61
                               Proto            => 'udp')
62
        or die("Unable to create socket: $!");
63
 
64
my $msg;
65 183 winston
my $port;
66
my $ipaddr;
67 237 winston
my $hname;
68 182 winston
while($sock->recv($msg, $MAXSIZE))
69
{
70 183 winston
        ($port, $ipaddr) = sockaddr_in($sock->peername);
71 237 winston
        $hname=$sock->peerhost();
72 182 winston
 
73
        my ($session, $retry, $cmd)=unpack("SCC", $msg);
74
        my $payload=substr($msg, 4);
75
 
76
        if($cmd != 0x00 && $ipaddr ne $SESSION{$session})
77
        {
78 237 winston
                printf("$hname: Session ID %x invalid\n", $session);
79 182 winston
                sendMsg(0x00, $cmd, 0xFF);
80
                next;
81
        }
82
 
83
        if(defined $TNFSCMDS{$cmd})
84
        {
85 201 winston
                $SEQNO{$session}=$retry;
86 182 winston
                $TNFSCMDS{$cmd}->($session, $retry, $cmd, $payload);
87
        }
88
        else
89
        {
90
                # reply ENOSYS 'operation not implemented'
91 237 winston
                printf("$hname: Operation %x not implemented\n", $cmd);
92 182 winston
                sendMsg($session, $cmd, 0x16);
93
        }
94
}
95
 
96
close($sock);
97
 
98
##########################################################################
99
# TNFS functions.
100
#
101
 
102
# mount: Allow a client to mount a filesystem.
103
sub mount
104
{
105
        my ($session, $retry, $cmd, $message)=@_;
106
 
107
        # Only one mount point at present. Get the client major/minor
108
        # number.
109
        my ($cminor, $cmajor)=unpack("CC", $message);
110
        my ($mountpoint, $user, $pw)=split(/\x0/, substr($message,2));
111
 
112
        my $session=makeSessionId();
113 201 winston
        $SEQNO{$session}=$retry;
114 182 winston
 
115 206 winston
        # convert path
116
        $mountpoint=$root . $mountpoint;
117
 
118 182 winston
        # check the mount point actually exists
119
        if(opendir(DHND, $mountpoint))
120
        {
121
                closedir(DHND);
122
                $SESSION{$session}=$ipaddr;
123
                $MOUNTPOINT{$session}=$mountpoint;
124
 
125 237 winston
                print("Mount: $mountpoint from $hname\n");
126 182 winston
                sendMsg($session, 0x00, 0x00, "\x00\x01\x00\x00");
127
        }
128
        else
129
        {
130
                # session is null, cmd is 0, error is ENOENT (0x02)
131
                # version is 1.0
132 237 winston
                print("Mount: FAILED for $mountpoint from $hname\n");
133 182 winston
                sendMsg(0, 0x00, 0x02, "\x00\x01");
134
        }
135
}
136
 
137 185 winston
# opendir: Open a directory handle.
138
sub opendir
139
{
140
        my ($session, $retry, $cmd, $message)=@_;
141
 
142
        # remove terminating characters or illegal sequences
143
        $message=~s/\x0|\.\.//g;
144
        my $path="$MOUNTPOINT{$session}/$message";
145
        my $dhnd;
146
        if(opendir($dhnd, $path))
147
        {
148
                # add to the directory handle table - first find out
149
                # whether this client has a directory table and create it
150
                # if not.
151
                my $clientHandle=0;
152
                if(not defined $DIRHANDLE{$session})
153
                {
154
                        my @hlist;
155
                        $hlist[0]=$dhnd;
156
                        $DIRHANDLE{$session}=\@hlist;
157
                }
158
                else
159
                {
160
                        my $hlist=$DIRHANDLE{$session};
161
                        my $laste=$#{@$hlist};
162
                        for(my $i=0; $i <= $laste; $i++)
163
                        {
164
                                if(not defined $hlist->[$i])
165
                                {
166
                                        $clientHandle=$i;
167
                                        $hlist->[$i]=$dhnd;
168
                                        last;
169
                                }
170
                        }
171
 
172
                        # didn't find a hole? Add to the end
173
                        if(!$clientHandle)
174
                        {
175
                                $clientHandle=$laste+1;
176
                                $hlist->[$clientHandle]=$dhnd;
177
                        }
178
 
179
                }
180 237 winston
                print("Opendir: $message from $hname\n");
181 185 winston
                sendMsg($session, 0x10, 0x00, pack("C", $clientHandle));
182
        }
183
        else
184
        {
185
                print("opendir failed for $message: $!");
186
 
187
                # todo: proper error code, but just ENOENT for now.
188
                sendMsg($session, 0x10, 0x02);
189
        }
190
}
191
 
192
# umount: closes a connection and frees all resources.
193
sub umount
194
{
195
        my ($session, $retry, $cmd, $message)=@_;
196
 
197
        my $dirhandles=$DIRHANDLE{$session};
198
        if(defined($dirhandles))
199
        {
200
                foreach my $dhnd (@$dirhandles)
201
                {
202
                        closedir($dhnd);
203
                }
204
                delete $DIRHANDLE{$session};
205
        }
206
 
207
        my $filehandles=$FILEHANDLE{$session};
208
        if(defined($filehandles))
209
        {
210
                foreach my $fhnd (@$filehandles)
211
                {
212
                        close($fhnd);
213
                }
214
                delete $FILEHANDLE{$session}
215
        }
216 237 winston
 
217
        # tell the client we're done before deleting
218
        # the important stuff needed to actually return the msg...
219
        sendMsg($session, 0x01, 0x00);
220
 
221
        delete $SESSION{$session};
222
        delete $SEQNO{$session};
223 185 winston
        delete $MOUNTPOINT{$session};
224
}
225
 
226
# readdir: Reads the next directory entry.
227
sub readdir
228
{
229
        my ($session, $retry, $cmd, $message)=@_;
230
 
231
        # Retrieve the directory handle
232
        my $clientHandle=unpack("C", $message);
233
        my $dhnd=$DIRHANDLE{$session}->[$clientHandle];
234
        if(defined $dhnd)
235
        {
236
                if(my $dirent=readdir($dhnd))
237
                {
238
                        sendMsg($session, 0x11, 0x00, "$dirent\x0");
239
                }
240
                else
241
                {
242
                        # At EOF
243
                        sendMsg($session, 0x11, 0x21);
244
                }
245
        }
246
        else
247
        {
248
                # Bad directory handle - EBADF
249
                sendMsg($session, 0x11, 0x06);
250
        }
251
}
252
 
253
# closedir: Close a directory and clean up resources.
254
sub closedir
255
{
256
        my ($session, $retry, $cmd, $message)=@_;
257
 
258
        # Retrieve the directory handle
259
        my $clientHandle=unpack("C", $message);
260
        my $dhnd=$DIRHANDLE{$session}->[$clientHandle];
261
        if(defined $dhnd)
262
        {
263
                closedir($dhnd);
264
                delete $DIRHANDLE{$session}->[$clientHandle];
265
                sendMsg($session, 0x12, 0x00);
266
        }
267
        else
268
        {
269
                # Bad directory handle - EBADF
270
                sendMsg($session, 0x12, 0x06);
271
        }
272
}
273
 
274 188 winston
# openFile: Open a file.
275
sub openFile
276
{
277
        my ($session, $cmd, $status, $msg)=@_;
278
        my ($filemode, $fileflags)=unpack("CC", $msg);
279
        my $filename=substr($msg, 2);
280
        $filename =~ s/\x0//g;
281
        my $path="$MOUNTPOINT{$session}" . $filename;
282 237 winston
        print("Open request: $path from $hname\n");
283 185 winston
 
284 188 winston
        # use sysopen to do, well, a sysopen.
285
        my $fhnd;
286
        if(sysopen($fhnd, $path, $MODE{$filemode} | getOpenFlags($fileflags)))
287
        {
288
                # add to the file handle table - first find out
289
                # whether this client has a directory table and create it
290
                # if not.
291
                my $clientHandle=0;
292
                if(not defined $FILEHANDLE{$session})
293
                {
294
                        my @hlist;
295
                        $hlist[0]=$fhnd;
296
                        $FILEHANDLE{$session}=\@hlist;
297
                }
298
                else
299
                {
300
                        my $hlist=$FILEHANDLE{$session};
301
                        my $laste=$#{@$hlist};
302
                        for(my $i=0; $i <= $laste; $i++)
303
                        {
304
                                if(not defined $hlist->[$i])
305
                                {
306
                                        $clientHandle=$i;
307
                                        $hlist->[$i]=$fhnd;
308
                                        last;
309
                                }
310
                        }
311
 
312
                        # didn't find a hole? Add to the end
313
                        if(!$clientHandle)
314
                        {
315
                                $clientHandle=$laste+1;
316
                                $hlist->[$clientHandle]=$fhnd;
317
                        }
318
 
319
                }
320 237 winston
                print("Handle=$clientHandle\n");
321 188 winston
                sendMsg($session, 0x20, 0x00, pack("C", $clientHandle));
322
 
323
        }
324
        else
325
        {
326
                my $err=int($!);
327
                sendMsg($session, 0x20, $err);
328
        }
329
}
330
 
331
# readBlock - Reads from an open file handle.
332
sub readBlock
333
{
334
        my ($session, $cmd, $status, $msg)=@_;
335
 
336
        my ($clientHandle, $szlsb, $szmsb)=unpack("CCC", $msg);
337
        my $blocksize=($szmsb*256)+$szlsb;
338
        my $fhnd=$FILEHANDLE{$session}->[$clientHandle];
339
        if(defined $fhnd)
340
        {
341
                my $block;
342
                my $bytes=sysread($fhnd, $block, $blocksize);
343
                if($bytes > 0)
344
                {
345
                        my $msg=pack("CC", $bytes%256, int($bytes/256)) .
346
                                $block;
347
                        sendMsg($session, 0x21, 0x00, $msg);
348
                }
349
                elsif($bytes == 0)
350
                {
351
                        sendMsg($session, 0x21, 0x21);  # EOF
352
                }
353
                else
354
                {
355
                        # send errno
356
                        sendMsg($session, 0x21, int($!));
357
                }
358
        }
359
        else
360
        {
361
                # Bad file handle - EBADF
362
                sendMsg($session, 0x21, 0x06);
363
        }
364
 
365
}
366
 
367
# write - Writes to an open file handle.
368
sub writeBlock
369
{
370
        my ($session, $cmd, $status, $msg)=@_;
371
 
372
        my ($clientHandle, $szlsb, $szmsb)=unpack("CCC", $msg);
373
        my $blocksize=($szmsb*256)+$szlsb;
374
        my $block=substr($msg, 3);
375
        my $fhnd=$FILEHANDLE{$session}->[$clientHandle];
376
        if(defined $fhnd)
377
        {
378
                my $bytes=syswrite($fhnd, $block, $blocksize);
379
                if($bytes > 0)
380
                {
381
                        my $msg=pack("CC", $bytes%256, int($bytes/256)) .
382
                                $block;
383
                        sendMsg($session, 0x22, 0x00, $msg);
384
                }
385
                else
386
                {
387
                        # send errno
388
                        sendMsg($session, 0x22, int($!));
389
                }
390
        }
391
        else
392
        {
393
                # Bad file handle - EBADF
394
                sendMsg($session, 0x21, 0x06);
395
        }
396
}
397
 
398
# close - Closes an open file handle.
399
sub closeFile
400
{
401
        my ($session, $cmd, $status, $msg)=@_;
402
 
403
        # Retrieve the file handle
404
        my $clientHandle=unpack("C", $msg);
405
        my $fhnd=$FILEHANDLE{$session}->[$clientHandle];
406
        if(defined $fhnd)
407
        {
408 255 winston
                print("Closed handle $clientHandle\n");
409
                close($fhnd);
410 188 winston
                delete $FILEHANDLE{$session}->[$clientHandle];
411
                sendMsg($session, 0x23, 0x00);
412
        }
413
        else
414
        {
415
                # Bad file handle - EBADF
416
                sendMsg($session, 0x23, 0x06);
417
        }
418
 
419
}
420
 
421 200 winston
# seekFile - Seeks to a location in a file. (Command 0x25)
422
sub seekFile
423
{
424
        my ($session, $cmd, $status, $msg)=@_;
425
 
426
        my ($clientHandle, $seektype, $seekloc)=unpack("CCl", $msg);
427 237 winston
        #print("seekFile: handle=$clientHandle type=$seektype loc=$seekloc\n");
428 200 winston
        my $fhnd=$FILEHANDLE{$session}->[$clientHandle];
429
        if(defined $fhnd)
430
        {
431
                # this assumes posix definitions of SEEK_CUR, SYS_END etc.
432 237 winston
                if(sysseek($fhnd, $seekloc, $seektype))
433 200 winston
                {
434
                        # success
435 237 winston
                        print("Seek OK\n");
436 200 winston
                        sendMsg($session, 0x25, 0x00);
437
                }
438
                else
439
                {
440 237 winston
                        print("Oops: $!\n");
441 200 winston
                        sendMsg($session, 0x25, int($!));
442
                }
443
        }
444
        else
445
        {
446
                # send EBADF
447
                sendMsg($session, 0x25, 0x06);
448
        }
449
}
450
 
451 197 winston
# statFile - gets information on a file.
452
sub statFile
453
{
454
        my ($session, $cmd, $status, $msg)=@_;
455
 
456
        # the message contains the file to stat, remove the terminator
457
        $msg=~s/\x00//g;
458
        my $filename=$MOUNTPOINT{$session} . $msg;
459 237 winston
        print("Statting $filename from $hname\n");
460 197 winston
        if(my @st=stat($filename))
461
        {
462
                # perms in big endian, rest in "vax order" - little
463
                # endian. (See perldoc for "pack")
464
                my $smsg=pack("vvvVVVV", $st[2], $st[4], $st[5],
465
                                $st[7], $st[8], $st[9], $st[10]);
466
                $smsg .= getpwuid($st[4]) . "\x0" . getgrgid($st[5]) . "\x0";
467
                sendMsg($session, 0x24, 0x00, $smsg);
468
 
469
        }
470
        else
471
        {
472
                # send error number
473
                sendMsg($session, 0x24, int($!));
474
        }
475
}
476
 
477 200 winston
# unlinkFile - Unlinks a file (cmd 0x26)
478
sub unlinkFile
479
{
480
        my ($session, $cmd, $status, $msg)=@_;
481
 
482
        # remove terminator and create the path
483
        $msg=~s/\x00//g;
484
        my $filename=$MOUNTPOINT{$session} . $msg;
485
        if(unlink $filename)
486
        {
487
                sendMsg($session, 0x26, 0x00);
488
        }
489
        else
490
        {
491
                sendMsg($session, 0x26, int($!));
492
        }
493
}
494
 
495
# chmodFile - Changes perms on a file (cmd 0x27)
496
sub chmodFile
497
{
498
        my ($session, $cmd, $status, $msg)=@_;
499
 
500
        # remove terminator and create the path
501
        $msg=~s/\x00$//g;
502
        my ($perm, $filename)=unpack("vA", $msg);
503
        $filename=$MOUNTPOINT{$session} . $filename;
504
        if(chmod($perm, $filename))
505
        {
506
                sendMsg($session, 0x27, 0x00);
507
        }
508
        else
509
        {
510
                sendMsg($session, 0x27, int($!));
511
        }
512
}
513
 
514 182 winston
sub sendMsg
515
{
516
        my ($session, $cmd, $status, $msg)=@_;
517 201 winston
        my $seq=$SEQNO{$session};
518 237 winston
#       print("message: Session $session cmd $cmd status $status seq $seq\n");
519 201 winston
        my $dgram=pack("SCCC", $session, $seq, $cmd, $status);
520 182 winston
        $dgram .= $msg;
521
        $LASTMSG{$session}=$dgram;
522
        $sock->send($dgram);
523
}
524
 
525
sub makeSessionId
526
{
527
        my $sid;
528
        do
529
        {
530
                $sid=int(rand(65536));
531
        } while($SESSION{$sid});
532
        return $sid;
533
}
534
 
535 188 winston
#---------------------------------------------------------------------------
536
# Miscellaneous functions
537
# getOpenFlags: convert tnfs flags to flags for open.
538
sub getOpenFlags
539
{
540
        my $flags=0;
541
        my $tf=shift;
542
 
543
        if($tf & 0x01) { $flags |= O_APPEND; }
544
        if($tf & 0x02) { $flags |= O_CREAT; }
545
        if($tf & 0x04) { $flags |= O_EXCL; }
546
        if($tf & 0x08) { $flags |= O_TRUNC; }
547
        return $flags;
548
}
549