Subversion Repositories Spectranet

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

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