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 @NETATALK_VERSION@.
  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         $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 !~ /^-/);
  39 }
  40
  41 if ($main::showver ==1)
  42 {
  43         print "$0\n";
  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";
  46         exit(-1);
  47 }
  48
  49 if ($hostport eq "")
  50 {
  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";
  58         exit(-1);
  59 }
  60
  61 ($host, $port) = split(/\:/, $hostport);
  62 $port = "548" if ($port eq "");
  63
  64 my ($packet) = build_packet();
  65 my ($code) = sendpacket($host, $port, $packet);
  66 exit $code;
  67
  68
  69 sub build_packet
  70 {
  71         my (@packet) =
  72                 (
  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
  79                 );
  80
  81
  82         my ($packet) = pack("C*", @packet);
  83
  84         return $packet;
  85
  86 }
  87
  88 sub sendpacket
  89 {
  90         my ($host, $port, $packet) = @_;
  91         my ($b, $buf);
  92
  93         print "opening $host:$port\n" if ($main::debug);
  94
  95         my ($asip_sock) = IO::Socket::INET->new(
  96                 PeerAddr => $host,
  97                 PeerPort => $port,
  98                 Proto => 'tcp',
  99                 Type => SOCK_STREAM,
 100                 Timeout => 10
 101                 ) || die "connect to $host failure: $!";
 102         $asip_sock->autoflush(1);
 103
 104         print "sending packet\n" if ($main::debug);
 105
 106         my ($count) = syswrite($asip_sock, $packet, length($packet));
 107
 108         if ($count != length($packet))
 109         {
 110                 print "only wrote $count of " . length($packet) . " bytes?\n";
 111                 exit(-1);
 112         }
 113
 114         # reply can span multiple packets
 115
 116         print "sysread: " if ($main::debug);
 117         while (sysread($asip_sock, $b, 256))
 118         {
 119                 $buf .= $b;
 120                 print "." if ($main::debug);
 121         }
 122
 123         close ($asip_sock);
 124
 125         print " read " . length($buf) . " bytes\n" if ($main::debug);
 126
 127         if (length($buf) == 0)
 128         {
 129                 print "empty reply packet?\n";
 130                 return -2;
 131         }
 132         else
 133         {
 134                 print "AFP reply from $host:$port\n";
 135                 return (parse_packet($buf));
 136         }
 137 }
 138
 139
 140 sub parse_packet
 141 {
 142         my ($buf) = shift @_;
 143         my (@packet);
 144         my ($i);
 145
 146         hexdump($buf) if ($main::hexdump);
 147
 148         for ($i=0;$i<length($buf);$i++)
 149         {
 150                 push(@packet, substr($buf, $i, 1));
 151         }
 152
 153         my ($flags) = unpack("C", @packet[0]);
 154         my ($cmd) = unpack("C", @packet[1]);
 155
 156         my ($request_id) = unpack("n", @packet[2] . @packet[3]);
 157         print "Flags: $flags  Cmd: $cmd  ID: $request_id\n";
 158
 159         print getasipsrv("flags", $flags) . ": " . getasipsrv("command", $cmd) . "\n";
 160         print "Request ID: $request_id\n";
 161
 162         print "** Request ID didn't match what we sent!\n" if ($request_id != 0xdead);
 163
 164         # "Error Code / Enclosed Data Offset"
 165         # I have never seen this be non-zero ..
 166
 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);
 169
 170         # "Total Data Length"
 171
 172         my ($datalen) = unpack("N2", @packet[8] . @packet[9] . @packet[10] . @packet[11]);
 173
 174         print "Total data length: $datalen\n" if ($main::debug);
 175
 176         # "Reserved Field"
 177
 178         my ($reserved) = unpack("N2", @packet[12] . @packet[13] . @packet[14] . @packet[15]);
 179
 180         print "Reserved field: $reserved\n" if ($reserved);
 181
 182         if ($cmd != 3)
 183         {
 184                 print "I can only parse packets of reply-type DSIGetStatus (3)\n";
 185                 print "This is reply-type " . getasipsrv("command", $cmd) . "\n";
 186         }
 187         if ($datalen == 0)
 188         {
 189                 print "No data in packet?\n";
 190         }
 191         if (($datalen > 0) && ($cmd == 3))
 192         {
 193                 my (@AFPpacket) = @packet[($edo+16)..($edo+16+$datalen)];
 194                 return (parse_FPGetSrvrInfo(@AFPpacket));
 195         }
 196         else
 197         {
 198                 print "I don't know how to parse this type of packet.\n";
 199                 return(2);
 200         }
 201 }
 202
 203
 204
 205 sub parse_FPGetSrvrInfo()
 206 {
 207         my (@packet) = @_;
 208         my ($i);
 209
 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";
 214
 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";
 219
 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";
 224
 225         my ($allow_guest) = 0;
 226         $allow_guest = 1 if (grep(/No User Authen/, @uams));
 227
 228         # it would be cute to see the icon.
 229
 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: ";
 233         if ($icon_offset) {
 234             print "Yes\n";
 235         } else {
 236             print "No\n";
 237         }
 238
 239         my ($flags) = unpack("n", @packet[8] . @packet[9]);
 240         my (@flags) = parse_afp_flags($flags);
 241
 242         print "Flags: ";
 243         print "$flags" if ($main::debug);
 244         print "\n";
 245         print join("\n", @flags) . "\n";
 246
 247         # server name starts at offset+10, length byte first.
 248
 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";
 253
 254         my ($offset) = 11 + $servername_len;
 255
 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
 258
 259         $offset++ if ($servername_len % 2 == 0);
 260
 261         print "New offset: $offset\n" if ($main::debug);
 262
 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)
 266         {
 267                 my ($signature) = join("",  @packet[$signature_offset..$signature_offset+15]);
 268
 269                 print "Signature:\n";
 270                 hexdump($signature);
 271         }
 272
 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);
 275
 276         extract_network_address($network_address_count_offset, @packet);
 277
 278         $offset += 4;
 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)
 283                 {
 284                         my (@dirsvcs) = extract(0, $directory_service_offset, @packet);
 285                         while (@dirsvcs)
 286                         {
 287                                 printf "Directory Service: %s\n", shift @dirsvcs;
 288                         }
 289                 }
 290                 $offset +=2;
 291         }
 292
 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)
 297                 {
 298                         my ($utf8name) = extract(1, $utf8_name_offset+1, @packet);
 299                         print "UTF8 Servername: $utf8name\n";
 300                 }
 301         }
 302
 303         draw_icon($icon_offset, @packet) if ($main::show_icon && $icon_offset);
 304
 305         return $allow_guest;
 306 }
 307
 308 # getsrvbyname .. sorta ..
 309
 310 sub getasipsrv
 311 {
 312         my ($what, $code) = @_;
 313
 314         if ($what eq "flags")
 315         {
 316                 return "Request" if ($code == 0);
 317                 return "Reply" if ($code == 1);
 318         }
 319
 320         if ($what eq "command")
 321         {
 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);
 329         }
 330         return "[$what/$code] unknown";
 331 }
 332
 333
 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..)
 338
 339 sub extract
 340 {
 341         my ($count, $offset, @packet) = @_;
 342         my ($i, $j);
 343         my (@items, $data);
 344         my ($hack);
 345
 346         if ($count == 0)
 347         {
 348                 ($count) = unpack("C", @packet[$offset]);
 349                 return if ($count == 0);
 350                 $offset++;
 351         }
 352         else
 353         {
 354                 $hack = 1;
 355         }
 356         #print ">> extracting $count items from offset $offset\n";
 357         for ($i=0;$i<$count;$i++)
 358         {
 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";
 366         }
 367         return $data if ($hack);
 368         return @items;
 369 }
 370
 371 sub draw_icon
 372 {
 373         my ($offset, @packet) = @_;
 374         my ($cols);
 375         my ($i, $j);
 376
 377         # icons are 32x32 bitmaps; 128 byte icon + 128 byte mask
 378         # to show the mask, change 128 to 256.
 379
 380         for ($i=0;$i<128;$i++)
 381         {
 382                 my ($c) = @packet[$i+$offset];
 383                 my ($bin) = unpack ("B*", $c);
 384
 385                 for ($j=0;$j<8;$j++)
 386                 {
 387                         if (substr($bin, $j, 1))
 388                         {
 389                                 print "#";
 390                         }
 391                         else
 392                         {
 393                                 print " ";
 394                         }
 395                 }
 396                 $cols++;
 397                 if ($cols == 4)
 398                 {
 399                         $cols = 0;
 400                         print "\n";
 401                 }
 402
 403         }
 404         print "\n";
 405 }
 406
 407
 408 sub parse_afp_flags
 409 {
 410         my ($flags) = shift @_;
 411         my (@flags);
 412
 413         # $flags is a 16 bit little-endian number
 414
 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));
 431
 432         return @flags;
 433 }
 434
 435
 436 sub hexdump
 437 {
 438         my ($buf) = @_;
 439         my ($p, $c, $pc, $str);
 440         my ($i);
 441
 442         for ($i=0;$i<length($buf);$i++)
 443         {
 444                 $p = substr($buf, $i, 1);
 445                 $c = ord ($p);
 446                 printf "%.2x ", $c;
 447                 $pc++;
 448                 if (($c > 31) && ($c < 127))
 449                 {
 450                         $str .= $p;
 451                 }
 452                 else
 453                 {
 454                         $str .= ".";
 455                 }
 456                 if ($pc == 16)
 457                 {
 458                         print " $str\n";
 459                         undef $str;
 460                         $pc = 0;
 461                 }
 462         }
 463         print "   " x (16 - $pc);
 464         print " $str \n";
 465 }
 466
 467
 468 sub extract_network_address
 469 {
 470         my ($offset, @packet) = @_;
 471         my ($count);
 472         my ($i) = 0;
 473         my ($data);
 474
 475         # get the number of addresses
 476         ($count) = unpack("C", @packet[$offset]);
 477         return if ($count == 0);
 478         $offset++;
 479
 480         #print "\n>> extracting $count items from offset $offset\n";
 481         for ($i=0;$i<$count;$i++)
 482         {
 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";
 492
 493
 494                 # 1st byte is 'tag'
 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)
 498                 # 4 - DNS address
 499                 # 5 - IP address (4) + port (2), for SSH tunnel
 500                 # 6 - IPV6 address (16)
 501                 # 7 - IPV6 address (16) + port (2)
 502
 503                 my (@nap) = unpack("C*", $data);
 504
 505                 if ($type == 1)
 506                 {
 507                         # quad
 508                         my ($ip) = sprintf "%d.%d.%d.%d (TCP/IP address)",
 509                                 $nap[0], $nap[1], @nap[2], @nap[3];
 510
 511                         print "Network address: $ip\n";
 512                 }
 513                 elsif ($type == 2)
 514                 {
 515                         # quad+port
 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";
 519                 }
 520                 elsif ($type == 3)
 521                 {
 522                         printf "Network address: %d.%d (ddp address)\n",
 523                                 (@nap[0] * 256) + @nap[1], @nap[2];
 524                 }
 525                 elsif ($type == 4)
 526                 {
 527                         print "Network address: $data (DNS address)\n";
 528                 }
 529                 elsif ($type == 5)
 530                 {
 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";
 534                 }
 535                 elsif ($type == 6 || $type == 7)
 536                 {
 537                         print "Network address: ";
 538                         my ($j) = 0;
 539                         for ( $j = 0; $j<=13; $j = $j+2) {
 540                                 printf("%.2x%.2x:", @nap[$j], @nap[$j+1]);
 541                         }
 542                         printf("%.2x%.2x", @nap[14], @nap[15]);
 543                         if ($type == 7 ) {
 544                                 printf(":%d", (@nap[16]*256) + @nap[17]);
 545                                 print " (IPv6 address + port)\n";
 546                         }
 547                         else {
 548                                 print " (IPv6 address)\n";
 549                         }
 550                 }
 551                 else
 552                 {
 553                         printf "unsupported address type: %u\n", $type;
 554                 }
 555
 556         }
 557 }