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