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 22use strict; 23use IO::Socket; # sucks because Timeout doesn't 24 25my ($arg); 26my ($hostport); 27my ($host); 28my ($port); 29 30while ($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 41if ($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 49if ($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 64my ($packet) = build_packet(); 65my ($code) = sendpacket($host, $port, $packet); 66exit $code; 67 68 69sub 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 88sub 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 140sub 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 205sub 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 310sub 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 339sub 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 371sub 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 408sub 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 436sub 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 468sub 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} 558