1#!/usr/bin/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 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 $hostport = $arg if ($arg !~ /^-/); 36} 37 38if ($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 47my ($packet) = build_packet(); 48my ($code) = sendpacket($host, $port, $packet); 49exit $code; 50 51 52sub 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 71sub 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 123sub 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 188sub 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 287sub 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 316sub 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 348sub 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 385sub 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 409sub 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 441sub 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} 531