contrib/shell_utils/asip-status.pl.in

   1 #!@PERL@
   2 #
   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.
   6 #
   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
  11 # see also:
  12 #   - http://developer.apple.com/techpubs/macos8/NetworkCommSvcs/AppleShare/
  13 #   - http://www2.opendoor.com/asip/   (excellent Mac sharing / security site)
  14 #
  15 # todo: log in as guest & get a list of shares
  16 #
  17
  18 #
  19 # This edition is a part of netatalk.
  20 #
  21
  22 use strict;
  23 use IO::Socket;                 # sucks because Timeout doesn't
  24
  25 my ($arg);
  26 my ($hostport);
  27 my ($host);
  28 my ($port);
  29
  30 while ($arg = shift @ARGV)
  31 {
  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         $hostport = $arg if ($arg !~ /^-/);
  36 }
  37
  38 if ($hostport eq "")
  39 {
  40         print "usage: $0 hostname[:port] [-i show icon] [-d debug] [-x hex dump]\n";
  41         exit(-1);
  42 }
  43
  44 ($host, $port) = split(/\:/, $hostport);
  45 $port = "548" if ($port eq "");
  46
  47 my ($packet) = build_packet();
  48 my ($code) = sendpacket($host, $port, $packet);
  49 exit $code;
  50
  51
  52 sub build_packet
  53 {
  54         my (@packet) =
  55                 (
  56                 0x00,                   # 0- request, 1-reply
  57                 0x03,                   # 3- DSIGetStatus
  58                 0xde, 0xad, 0x00,       # request ID
  59                 0x00, 0x00, 0x00, 0x00, # data field
  60                 0x00, 0x00, 0x00, 0x00, # length of data stream header
  61                 0x00, 0x00, 0x00, 0x00  # reserved
  62                 );
  63
  64
  65         my ($packet) = pack("C*", @packet);
  66
  67         return $packet;
  68
  69 }
  70
  71 sub sendpacket
  72 {
  73         my ($host, $port, $packet) = @_;
  74         my ($b, $buf);
  75
  76         print "opening $host:$port\n" if ($main::debug);
  77
  78         my ($asip_sock) = IO::Socket::INET->new(
  79                 PeerAddr => $host,
  80                 PeerPort => $port,
  81                 Proto => 'tcp',
  82                 Type => SOCK_STREAM,
  83                 Timeout => 10
  84                 ) || die "connect to $host failure: $!";
  85         $asip_sock->autoflush(1);
  86
  87         print "sending packet\n" if ($main::debug);
  88
  89         my ($count) = syswrite($asip_sock, $packet, length($packet));
  90
  91         if ($count != length($packet))
  92         {
  93                 print "only wrote $count of " . length($packet) . " bytes?\n";
  94                 exit(-1);
  95         }
  96
  97         # reply can span multiple packets
  98
  99         print "sysread: " if ($main::debug);
 100         while (sysread($asip_sock, $b, 256))
 101         {
 102                 $buf .= $b;
 103                 print "." if ($main::debug);
 104         }
 105
 106         close ($asip_sock);
 107
 108         print " read " . length($buf) . " bytes\n" if ($main::debug);
 109
 110         if (length($buf) == 0)
 111         {
 112                 print "empty reply packet?\n";
 113                 return -2;
 114         }
 115         else
 116         {
 117                 print "AFP reply from $host:$port\n";
 118                 return (parse_packet($buf));
 119         }
 120 }
 121
 122
 123 sub parse_packet
 124 {
 125         my ($buf) = shift @_;
 126         my (@packet);
 127         my ($i);
 128
 129         hexdump($buf) if ($main::hexdump);
 130
 131         for ($i=0;$i<length($buf);$i++)
 132         {
 133                 push(@packet, substr($buf, $i, 1));
 134         }
 135
 136         my ($flags) = unpack("C", @packet[0]);
 137         my ($cmd) = unpack("C", @packet[1]);
 138
 139         my ($request_id) = unpack("n", @packet[2] . @packet[3]);
 140         print "Flags: $flags  Cmd: $cmd  ID: $request_id\n";
 141
 142         print getasipsrv("flags", $flags) . ": " . getasipsrv("command", $cmd) . "\n";
 143         print "Request ID: $request_id\n";
 144
 145         print "** Request ID didn't match what we sent!\n" if ($request_id != 0xdead);
 146
 147         # "Error Code / Enclosed Data Offset"
 148         # I have never seen this be non-zero ..
 149
 150         my ($edo) = unpack("N2", @packet[4] . @packet[5] . @packet[6] . @packet[7]);
 151         print "** Wow, a non-zero Error/Enclosed Data Offset: $edo\n" if ($edo);
 152
 153         # "Total Data Length"
 154
 155         my ($datalen) = unpack("N2", @packet[8] . @packet[9] . @packet[10] . @packet[11]);
 156
 157         print "Total data length: $datalen\n" if ($main::debug);
 158
 159         # "Reserved Field"
 160
 161         my ($reserved) = unpack("N2", @packet[12] . @packet[13] . @packet[14] . @packet[15]);
 162
 163         print "Reserved field: $reserved\n" if ($reserved);
 164
 165         if ($cmd != 3)
 166         {
 167                 print "I can only parse packets of reply-type DSIGetStatus (3)\n";
 168                 print "This is reply-type " . getasipsrv("command", $cmd) . "\n";
 169         }
 170         if ($datalen == 0)
 171         {
 172                 print "No data in packet?\n";
 173         }
 174         if (($datalen > 0) && ($cmd == 3))
 175         {
 176                 my (@AFPpacket) = @packet[($edo+16)..($edo+16+$datalen)];
 177                 return (parse_FPGetSrvrInfo(@AFPpacket));
 178         }
 179         else
 180         {
 181                 print "I don't know how to parse this type of packet.\n";
 182                 return(2);
 183         }
 184 }
 185
 186
 187
 188 sub parse_FPGetSrvrInfo()
 189 {
 190         my (@packet) = @_;
 191         my ($i);
 192
 193         my ($machinetype_offset) = unpack("n", @packet[0] . @packet[1]);
 194         print "Machine type offset in packet: $machinetype_offset\n" if ($main::debug);
 195         my ($machinetype) = extract(1, $machinetype_offset, @packet);
 196         print "Machine type: $machinetype\n";
 197
 198         my ($afpversioncount_offset) = unpack("n", @packet[2] . @packet[3]);
 199         print "AFPversion count offset: $afpversioncount_offset\n" if ($main::debug);
 200         my (@afpversions) = extract(0, $afpversioncount_offset, @packet);
 201         print "AFP versions: " . join(",", @afpversions) . "\n";
 202
 203         my ($uamcount_offset) = unpack("n", @packet[4] . @packet[5]);
 204         print "UAMcount offset: $uamcount_offset\n" if ($main::debug);
 205         my (@uams) = extract(0, $uamcount_offset, @packet);
 206         print "UAMs: " . join(",", @uams) . "\n";
 207
 208         my ($allow_guest) = 0;
 209         $allow_guest = 1 if (grep(/No User Authen/, @uams));
 210
 211         # it would be cute to see the icon.
 212
 213         my ($icon_offset) = unpack("n", @packet[6] . @packet[7]);
 214         print "Volume Icon & Mask offset: $icon_offset\n" if ($main::debug);
 215         print "Volume Icon & Mask: exist\n" if ($icon_offset);
 216
 217         my ($flags) = unpack("n", @packet[8] . @packet[9]);
 218         my (@flags) = parse_afp_flags($flags);
 219
 220         print "Flags: ";
 221         print "$flags - " if ($main::debug);
 222         print join(",", @flags) . "\n";
 223
 224         # server name starts at offset+10, length byte first.
 225
 226         my ($servername_len) = unpack("C1", @packet[10]);
 227         my ($servername) = join("", @packet[11..(11+$servername_len-1)]);
 228         print "Server name length: $servername_len\n" if ($main::debug);
 229         print "Server name: $servername\n";
 230
 231         my ($offset) = 11 + $servername_len;
 232
 233         # quietly ++ the $offset to account for the padding that happens
 234         # in the reply packet if the field names don't align on an even boundary
 235
 236         $offset++ if ($servername_len % 2 == 0);
 237
 238         print "New offset: $offset\n" if ($main::debug);
 239
 240         my ($signature_offset) = unpack("n2", @packet[$offset] . @packet[$offset+1]);
 241         print "Signature offset: $signature_offset\n" if ($main::debug);
 242         if ($signature_offset)
 243         {
 244                 my ($signature) = join("",  @packet[$signature_offset..$signature_offset+15]);
 245
 246                 print "Signature:\n";
 247                 hexdump($signature);
 248         }
 249
 250         my ($network_address_count_offset) = unpack("n2", @packet[$offset+2] . @packet[$offset+3]);
 251         print "Network address count offset: $network_address_count_offset\n" if ($main::debug);
 252
 253         extract_network_address($network_address_count_offset, @packet);
 254
 255         $offset += 4;
 256         if ($flags & (1<<8)) { # Supports directory services
 257                 my ($directory_service_offset) = unpack("n2", @packet[$offset] . @packet[$offset+1]);
 258                 print "Directory service offset: $directory_service_offset\n" if ($main::debug);
 259                 if ($directory_service_offset)
 260                 {
 261                         my (@dirsvcs) = extract(0, $directory_service_offset, @packet);
 262                         while (@dirsvcs)
 263                         {
 264                                 printf "Directory Service: %s\n", shift @dirsvcs;
 265                         }
 266                 }
 267                 $offset +=2;
 268         }
 269
 270         if ($flags & (1<<9)) { # Supports UTF8 servername
 271                 my ($utf8_name_offset) = unpack("n2", @packet[$offset] . @packet[$offset+1]);
 272                 print "UTF8 name offset: $utf8_name_offset\n" if ($main::debug);
 273                 if ($utf8_name_offset)
 274                 {
 275                         my ($utf8name) = extract(1, $utf8_name_offset+1, @packet);
 276                         print "UTF8 Servername: $utf8name\n";
 277                 }
 278         }
 279
 280         draw_icon($icon_offset, @packet) if ($main::show_icon && $icon_offset);
 281
 282         return $allow_guest;
 283 }
 284
 285 # getsrvbyname .. sorta ..
 286
 287 sub getasipsrv
 288 {
 289         my ($what, $code) = @_;
 290
 291         if ($what eq "flags")
 292         {
 293                 return "Request" if ($code == 0);
 294                 return "Reply" if ($code == 1);
 295         }
 296
 297         if ($what eq "command")
 298         {
 299                 return "DSICloseSession" if ($code == 1);
 300                 return "DSICommand" if ($code == 2);
 301                 return "DSIGetStatus" if ($code == 3);
 302                 return "DSIOpenSession" if ($code == 4);
 303                 return "DSITickle" if ($code == 5);
 304                 return "DSIWrite" if ($code == 6);
 305                 return "DSIAttention" if ($code == 7);
 306         }
 307         return "[$what/$code] unknown";
 308 }
 309
 310
 311 # return "counted" data at @packet[$offset]
 312 # when called with a zero as the first argument, this will
 313 # look in the packet for the count.  Otherwise, it will
 314 # assume I know what I'm doing.  (hah, what a foolish function..)
 315
 316 sub extract
 317 {
 318         my ($count, $offset, @packet) = @_;
 319         my ($i, $j);
 320         my (@items, $data);
 321         my ($hack);
 322
 323         if ($count == 0)
 324         {
 325                 ($count) = unpack("C", @packet[$offset]);
 326                 return if ($count == 0);
 327                 $offset++;
 328         }
 329         else
 330         {
 331                 $hack = 1;
 332         }
 333         #print ">> extracting $count items from offset $offset\n";
 334         for ($i=0;$i<$count;$i++)
 335         {
 336                 #print "Working on count $i\n";
 337                 my ($len) = unpack("C1", @packet[$offset]);
 338                 $data = join("",  @packet[$offset+1..$offset+$len]);
 339                 #print "$i. [$data] ($len)\n";
 340                 push (@items, $data);
 341                 $offset = $offset + $len + 1;
 342                 #print "new offset is $offset\n";
 343         }
 344         return $data if ($hack);
 345         return @items;
 346 }
 347
 348 sub draw_icon
 349 {
 350         my ($offset, @packet) = @_;
 351         my ($cols);
 352         my ($i, $j);
 353
 354         # icons are 32x32 bitmaps; 128 byte icon + 128 byte mask
 355         # to show the mask, change 128 to 256.
 356
 357         for ($i=0;$i<128;$i++)
 358         {
 359                 my ($c) = @packet[$i+$offset];
 360                 my ($bin) = unpack ("B*", $c);
 361
 362                 for ($j=0;$j<8;$j++)
 363                 {
 364                         if (substr($bin, $j, 1))
 365                         {
 366                                 print "#";
 367                         }
 368                         else
 369                         {
 370                                 print " ";
 371                         }
 372                 }
 373                 $cols++;
 374                 if ($cols == 4)
 375                 {
 376                         $cols = 0;
 377                         print "\n";
 378                 }
 379
 380         }
 381         print "\n";
 382 }
 383
 384
 385 sub parse_afp_flags
 386 {
 387         my ($flags) = shift @_;
 388         my (@flags);
 389
 390         # $flags is a 16 bit little-endian number
 391
 392         push (@flags, "SupportsCopyFile") if ($flags & (1<<0));
 393         push (@flags, "SupportsChgPwd") if ($flags & (1<<1));
 394         push (@flags, "DontAllowSavePwd") if ($flags & (1<<2));
 395         push (@flags, "SupportsServerMessages") if ($flags & (1<<3));
 396         push (@flags, "SupportsServerSignature") if ($flags & (1<<4));
 397         push (@flags, "SupportsTCP/IP") if ($flags & (1<<5));
 398         push (@flags, "SupportsSrvrNotifications") if ($flags & (1<<6));
 399         push (@flags, "SupportsReconnect") if ($flags & (1<<7));
 400         push (@flags, "SupportsOpenDirectory") if ($flags & (1<<8));
 401         push (@flags, "SupportsUTF8Servername") if ($flags & (1<<9));
 402         push (@flags, "SupportsUUIDs") if ($flags & (1<<10));
 403         push (@flags, "SupportsSuperClient") if ($flags & (1<<15));
 404
 405         return @flags;
 406 }
 407
 408
 409 sub hexdump
 410 {
 411         my ($buf) = @_;
 412         my ($p, $c, $pc, $str);
 413         my ($i);
 414
 415         for ($i=0;$i<length($buf);$i++)
 416         {
 417                 $p = substr($buf, $i, 1);
 418                 $c = ord ($p);
 419                 printf "%.2x ", $c;
 420                 $pc++;
 421                 if (($c > 31) && ($c < 127))
 422                 {
 423                         $str .= $p;
 424                 }
 425                 else
 426                 {
 427                         $str .= ".";
 428                 }
 429                 if ($pc == 16)
 430                 {
 431                         print " $str\n";
 432                         undef $str;
 433                         $pc = 0;
 434                 }
 435         }
 436         print "   " x (16 - $pc);
 437         print " $str \n";
 438 }
 439
 440
 441 sub extract_network_address
 442 {
 443         my ($offset, @packet) = @_;
 444         my ($count);
 445         my ($i) = 0;
 446         my ($data);
 447
 448         # get the number of addresses
 449         ($count) = unpack("C", @packet[$offset]);
 450         return if ($count == 0);
 451         $offset++;
 452
 453         #print "\n>> extracting $count items from offset $offset\n";
 454         for ($i=0;$i<$count;$i++)
 455         {
 456                 #print "Working on count $i\n";
 457                 my ($len) = unpack("C1", @packet[$offset]);
 458                 #printf "len:  %u\n",$len;
 459                 my ($type) = unpack("C1", @packet[$offset+1]);
 460                 #printf "type: %u\n",$type;
 461                 $data = join("",  @packet[$offset+2..$offset+$len-1]);
 462                 #print "$i. [$data] ($len)\n";
 463                 $offset = $offset + $len ;
 464                 #print "new offset is $offset\n";
 465
 466
 467                 # 1st byte is 'tag'
 468                 # 1 - IP address; 4 bytes
 469                 # 2 - IP address (4) + port (2)
 470                 # 3 - DDP (2 bytes net, 1 byte node, 1 byte socket)
 471                 # 4 - DNS address
 472                 # 5 - IP address (4) + port (2), for SSH tunnel
 473                 # 6 - IPV6 address (16)
 474                 # 7 - IPV6 address (16) + port (2)
 475
 476                 my (@nap) = unpack("C*", $data);
 477
 478                 if ($type == 1)
 479                 {
 480                         # quad
 481                         my ($ip) = sprintf "%d.%d.%d.%d (TCP/IP address)",
 482                                 $nap[0], $nap[1], @nap[2], @nap[3];
 483
 484                         print "Network address: $ip\n";
 485                 }
 486                 elsif ($type == 2)
 487                 {
 488                         # quad+port
 489                         my ($ipport) = sprintf "%d.%d.%d.%d:%d",
 490                                 @nap[0], @nap[1], @nap[2], @nap[3], (@nap[4]*256 + @nap[5]);
 491                         print "Network address: $ipport (TCP/IP address and port)\n";
 492                 }
 493                 elsif ($type == 3)
 494                 {
 495                         printf "Network address: %d.%d (ddp address)\n",
 496                                 (@nap[0] * 256) + @nap[1], @nap[2];
 497                 }
 498                 elsif ($type == 4)
 499                 {
 500                         print "Network address: $data (DNS address)\n";
 501                 }
 502                 elsif ($type == 5)
 503                 {
 504                         # according to the specs this should be an IP address
 505                         # however, OSX Server uses the FQDN instead
 506                         print "Network address: $data (SSH tunnel address)\n";
 507                 }
 508                 elsif ($type == 6 || $type == 7)
 509                 {
 510                         print "Network address: ";
 511                         my ($j) = 0;
 512                         for ( $j = 0; $j<=13; $j = $j+2) {
 513                                 printf("%.2x%.2x:", @nap[$j], @nap[$j+1]);
 514                         }
 515                         printf("%.2x%.2x", @nap[14], @nap[15]);
 516                         if ($type == 7 ) {
 517                                 printf(":%d", (@nap[16]*256) + @nap[17]);
 518                                 print " (IPv6 address + port)\n";
 519                         }
 520                         else {
 521                                 print " (IPv6 address)\n";
 522                         }
 523                 }
 524                 else
 525                 {
 526                         printf "unsupported address type: %u\n", $type;
 527                 }
 528
 529         }
 530 }