3 # asip-status - send DSIGetStatus to an AppleShare IP file server (aka
4 # ASIP, aka AFP over TCP port 548). A returned UAM of
5 # "No User Authen" means that the server supports guest access.
7 # author: James W. Abendschan <jwa@jammed.com>
8 # license: GPL - http://www.gnu.org/copyleft/gpl.html
9 # url: http://www.jammed.com/~jwa/hacks/security/asip/
10 # Date: 7 May 1997 (v1.0) - original version
12 # - http://developer.apple.com/techpubs/macos8/NetworkCommSvcs/AppleShare/
13 # - http://www2.opendoor.com/asip/ (excellent Mac sharing / security site)
15 # todo: log in as guest & get a list of shares
19 # This edition is a part of netatalk @NETATALK_VERSION@.
23 use IO::Socket; # sucks because Timeout doesn't
30 while ($arg = shift @ARGV)
32 $main::show_icon = 1 if ($arg eq "-i");
33 $main::debug = 1 if ($arg eq "-d");
34 $main::hexdump = 1 if ($arg eq "-x");
35 $main::showver = 1 if ($arg eq "-v");
36 $main::showver = 1 if ($arg eq "-version");
37 $main::showver = 1 if ($arg eq "--version");
38 $hostport = $arg if ($arg !~ /^-/);
41 if ($main::showver ==1)
44 print "Original edition: 7 May 1997 \(v1.0\) James W. Abendschan\n";
45 print "This edition is a part of Netatalk @NETATALK_VERSION@\n";
51 print "usage: $0 [-d] [-i] [-x] hostname[:port]\n";
52 print " $0 -v|-version|--version\n";
53 print "Queries AFP servers for their capabilities.\n";
54 print " -d: Enable debug output.\n";
55 print " -i: Show icon if it exists.\n";
56 print " -x: Enable hex dump output.\n";
57 print " -v,-version,--version: Show version.\n";
61 ($host, $port) = split(/\:/, $hostport);
62 $port = "548" if ($port eq "");
64 my ($packet) = build_packet();
65 my ($code) = sendpacket($host, $port, $packet);
73 0x00, # 0- request, 1-reply
74 0x03, # 3- DSIGetStatus
75 0xde, 0xad, 0x00, # request ID
76 0x00, 0x00, 0x00, 0x00, # data field
77 0x00, 0x00, 0x00, 0x00, # length of data stream header
78 0x00, 0x00, 0x00, 0x00 # reserved
82 my ($packet) = pack("C*", @packet);
90 my ($host, $port, $packet) = @_;
93 print "opening $host:$port\n" if ($main::debug);
95 my ($asip_sock) = IO::Socket::INET->new(
101 ) || die "connect to $host failure: $!";
102 $asip_sock->autoflush(1);
104 print "sending packet\n" if ($main::debug);
106 my ($count) = syswrite($asip_sock, $packet, length($packet));
108 if ($count != length($packet))
110 print "only wrote $count of " . length($packet) . " bytes?\n";
114 # reply can span multiple packets
116 print "sysread: " if ($main::debug);
117 while (sysread($asip_sock, $b, 256))
120 print "." if ($main::debug);
125 print " read " . length($buf) . " bytes\n" if ($main::debug);
127 if (length($buf) == 0)
129 print "empty reply packet?\n";
134 print "AFP reply from $host:$port\n";
135 return (parse_packet($buf));
142 my ($buf) = shift @_;
146 hexdump($buf) if ($main::hexdump);
148 for ($i=0;$i<length($buf);$i++)
150 push(@packet, substr($buf, $i, 1));
153 my ($flags) = unpack("C", @packet[0]);
154 my ($cmd) = unpack("C", @packet[1]);
156 my ($request_id) = unpack("n", @packet[2] . @packet[3]);
157 print "Flags: $flags Cmd: $cmd ID: $request_id\n";
159 print getasipsrv("flags", $flags) . ": " . getasipsrv("command", $cmd) . "\n";
160 print "Request ID: $request_id\n";
162 print "** Request ID didn't match what we sent!\n" if ($request_id != 0xdead);
164 # "Error Code / Enclosed Data Offset"
165 # I have never seen this be non-zero ..
167 my ($edo) = unpack("N2", @packet[4] . @packet[5] . @packet[6] . @packet[7]);
168 print "** Wow, a non-zero Error/Enclosed Data Offset: $edo\n" if ($edo);
170 # "Total Data Length"
172 my ($datalen) = unpack("N2", @packet[8] . @packet[9] . @packet[10] . @packet[11]);
174 print "Total data length: $datalen\n" if ($main::debug);
178 my ($reserved) = unpack("N2", @packet[12] . @packet[13] . @packet[14] . @packet[15]);
180 print "Reserved field: $reserved\n" if ($reserved);
184 print "I can only parse packets of reply-type DSIGetStatus (3)\n";
185 print "This is reply-type " . getasipsrv("command", $cmd) . "\n";
189 print "No data in packet?\n";
191 if (($datalen > 0) && ($cmd == 3))
193 my (@AFPpacket) = @packet[($edo+16)..($edo+16+$datalen)];
194 return (parse_FPGetSrvrInfo(@AFPpacket));
198 print "I don't know how to parse this type of packet.\n";
205 sub parse_FPGetSrvrInfo()
210 my ($machinetype_offset) = unpack("n", @packet[0] . @packet[1]);
211 print "Machine type offset in packet: $machinetype_offset\n" if ($main::debug);
212 my ($machinetype) = extract(1, $machinetype_offset, @packet);
213 print "Machine type: $machinetype\n";
215 my ($afpversioncount_offset) = unpack("n", @packet[2] . @packet[3]);
216 print "AFPversion count offset: $afpversioncount_offset\n" if ($main::debug);
217 my (@afpversions) = extract(0, $afpversioncount_offset, @packet);
218 print "AFP versions: " . join(",", @afpversions) . "\n";
220 my ($uamcount_offset) = unpack("n", @packet[4] . @packet[5]);
221 print "UAMcount offset: $uamcount_offset\n" if ($main::debug);
222 my (@uams) = extract(0, $uamcount_offset, @packet);
223 print "UAMs: " . join(",", @uams) . "\n";
225 my ($allow_guest) = 0;
226 $allow_guest = 1 if (grep(/No User Authen/, @uams));
228 # it would be cute to see the icon.
230 my ($icon_offset) = unpack("n", @packet[6] . @packet[7]);
231 print "Volume Icon & Mask offset: $icon_offset\n" if ($main::debug);
232 print "Volume Icon & Mask: ";
239 my ($flags) = unpack("n", @packet[8] . @packet[9]);
240 my (@flags) = parse_afp_flags($flags);
243 print "$flags" if ($main::debug);
245 print join("\n", @flags) . "\n";
247 # server name starts at offset+10, length byte first.
249 my ($servername_len) = unpack("C1", @packet[10]);
250 my ($servername) = join("", @packet[11..(11+$servername_len-1)]);
251 print "Server name length: $servername_len\n" if ($main::debug);
252 print "Server name: $servername\n";
254 my ($offset) = 11 + $servername_len;
256 # quietly ++ the $offset to account for the padding that happens
257 # in the reply packet if the field names don't align on an even boundary
259 $offset++ if ($servername_len % 2 == 0);
261 print "New offset: $offset\n" if ($main::debug);
263 my ($signature_offset) = unpack("n2", @packet[$offset] . @packet[$offset+1]);
264 print "Signature offset: $signature_offset\n" if ($main::debug);
265 if ($signature_offset)
267 my ($signature) = join("", @packet[$signature_offset..$signature_offset+15]);
269 print "Signature:\n";
273 my ($network_address_count_offset) = unpack("n2", @packet[$offset+2] . @packet[$offset+3]);
274 print "Network address count offset: $network_address_count_offset\n" if ($main::debug);
276 extract_network_address($network_address_count_offset, @packet);
279 if ($flags & (1<<8)) { # Supports directory services
280 my ($directory_service_offset) = unpack("n2", @packet[$offset] . @packet[$offset+1]);
281 print "Directory service offset: $directory_service_offset\n" if ($main::debug);
282 if ($directory_service_offset)
284 my (@dirsvcs) = extract(0, $directory_service_offset, @packet);
287 printf "Directory Service: %s\n", shift @dirsvcs;
293 if ($flags & (1<<9)) { # Supports UTF8 servername
294 my ($utf8_name_offset) = unpack("n2", @packet[$offset] . @packet[$offset+1]);
295 print "UTF8 name offset: $utf8_name_offset\n" if ($main::debug);
296 if ($utf8_name_offset)
298 my ($utf8name) = extract(1, $utf8_name_offset+1, @packet);
299 print "UTF8 Servername: $utf8name\n";
303 draw_icon($icon_offset, @packet) if ($main::show_icon && $icon_offset);
308 # getsrvbyname .. sorta ..
312 my ($what, $code) = @_;
314 if ($what eq "flags")
316 return "Request" if ($code == 0);
317 return "Reply" if ($code == 1);
320 if ($what eq "command")
322 return "DSICloseSession" if ($code == 1);
323 return "DSICommand" if ($code == 2);
324 return "DSIGetStatus" if ($code == 3);
325 return "DSIOpenSession" if ($code == 4);
326 return "DSITickle" if ($code == 5);
327 return "DSIWrite" if ($code == 6);
328 return "DSIAttention" if ($code == 7);
330 return "[$what/$code] unknown";
334 # return "counted" data at @packet[$offset]
335 # when called with a zero as the first argument, this will
336 # look in the packet for the count. Otherwise, it will
337 # assume I know what I'm doing. (hah, what a foolish function..)
341 my ($count, $offset, @packet) = @_;
348 ($count) = unpack("C", @packet[$offset]);
349 return if ($count == 0);
356 #print ">> extracting $count items from offset $offset\n";
357 for ($i=0;$i<$count;$i++)
359 #print "Working on count $i\n";
360 my ($len) = unpack("C1", @packet[$offset]);
361 $data = join("", @packet[$offset+1..$offset+$len]);
362 #print "$i. [$data] ($len)\n";
363 push (@items, $data);
364 $offset = $offset + $len + 1;
365 #print "new offset is $offset\n";
367 return $data if ($hack);
373 my ($offset, @packet) = @_;
377 # icons are 32x32 bitmaps; 128 byte icon + 128 byte mask
378 # to show the mask, change 128 to 256.
380 for ($i=0;$i<128;$i++)
382 my ($c) = @packet[$i+$offset];
383 my ($bin) = unpack ("B*", $c);
387 if (substr($bin, $j, 1))
410 my ($flags) = shift @_;
413 # $flags is a 16 bit little-endian number
415 push (@flags, " SupportsCopyFile") if ($flags & (1<<0));
416 push (@flags, " SupportsChgPwd") if ($flags & (1<<1));
417 push (@flags, " DontAllowSavePwd") if ($flags & (1<<2));
418 push (@flags, " SupportsServerMessages") if ($flags & (1<<3));
419 push (@flags, " SupportsServerSignature") if ($flags & (1<<4));
420 push (@flags, " SupportsTCP/IP") if ($flags & (1<<5));
421 push (@flags, " SupportsSrvrNotifications") if ($flags & (1<<6));
422 push (@flags, " SupportsReconnect") if ($flags & (1<<7));
423 push (@flags, " SupportsOpenDirectory") if ($flags & (1<<8));
424 push (@flags, " SupportsUTF8Servername") if ($flags & (1<<9));
425 push (@flags, " SupportsUUIDs") if ($flags & (1<<10));
426 push (@flags, " SupportsExtSleep") if ($flags & (1<<11));
427 push (@flags, " UnknownBit12") if ($flags & (1<<12));
428 push (@flags, " UnknownBit13") if ($flags & (1<<13));
429 push (@flags, " UnknownBit14") if ($flags & (1<<14));
430 push (@flags, " SupportsSuperClient") if ($flags & (1<<15));
439 my ($p, $c, $pc, $str);
442 for ($i=0;$i<length($buf);$i++)
444 $p = substr($buf, $i, 1);
448 if (($c > 31) && ($c < 127))
463 print " " x (16 - $pc);
468 sub extract_network_address
470 my ($offset, @packet) = @_;
475 # get the number of addresses
476 ($count) = unpack("C", @packet[$offset]);
477 return if ($count == 0);
480 #print "\n>> extracting $count items from offset $offset\n";
481 for ($i=0;$i<$count;$i++)
483 #print "Working on count $i\n";
484 my ($len) = unpack("C1", @packet[$offset]);
485 #printf "len: %u\n",$len;
486 my ($type) = unpack("C1", @packet[$offset+1]);
487 #printf "type: %u\n",$type;
488 $data = join("", @packet[$offset+2..$offset+$len-1]);
489 #print "$i. [$data] ($len)\n";
490 $offset = $offset + $len ;
491 #print "new offset is $offset\n";
495 # 1 - IP address; 4 bytes
496 # 2 - IP address (4) + port (2)
497 # 3 - DDP (2 bytes net, 1 byte node, 1 byte socket)
499 # 5 - IP address (4) + port (2), for SSH tunnel
500 # 6 - IPV6 address (16)
501 # 7 - IPV6 address (16) + port (2)
503 my (@nap) = unpack("C*", $data);
508 my ($ip) = sprintf "%d.%d.%d.%d (TCP/IP address)",
509 $nap[0], $nap[1], @nap[2], @nap[3];
511 print "Network address: $ip\n";
516 my ($ipport) = sprintf "%d.%d.%d.%d:%d",
517 @nap[0], @nap[1], @nap[2], @nap[3], (@nap[4]*256 + @nap[5]);
518 print "Network address: $ipport (TCP/IP address and port)\n";
522 printf "Network address: %d.%d (ddp address)\n",
523 (@nap[0] * 256) + @nap[1], @nap[2];
527 print "Network address: $data (DNS address)\n";
531 # according to the specs this should be an IP address
532 # however, OSX Server uses the FQDN instead
533 print "Network address: $data (SSH tunnel address)\n";
535 elsif ($type == 6 || $type == 7)
537 print "Network address: ";
539 for ( $j = 0; $j<=13; $j = $j+2) {
540 printf("%.2x%.2x:", @nap[$j], @nap[$j+1]);
542 printf("%.2x%.2x", @nap[14], @nap[15]);
544 printf(":%d", (@nap[16]*256) + @nap[17]);
545 print " (IPv6 address + port)\n";
548 print " (IPv6 address)\n";
553 printf "unsupported address type: %u\n", $type;