1"====================================================================== 2| 3| FTP protocol support 4| 5| 6 ======================================================================" 7 8"====================================================================== 9| 10| Based on code copyright (c) Kazuki Yasumatsu, and in the public domain 11| Copyright (c) 2002, 2008 Free Software Foundation, Inc. 12| Adapted by Paolo Bonzini. 13| 14| This file is part of the GNU Smalltalk class library. 15| 16| The GNU Smalltalk class library is free software; you can redistribute it 17| and/or modify it under the terms of the GNU Lesser General Public License 18| as published by the Free Software Foundation; either version 2.1, or (at 19| your option) any later version. 20| 21| The GNU Smalltalk class library is distributed in the hope that it will be 22| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of 23| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser 24| General Public License for more details. 25| 26| You should have received a copy of the GNU Lesser General Public License 27| along with the GNU Smalltalk class library; see the file COPYING.LIB. 28| If not, write to the Free Software Foundation, 59 Temple Place - Suite 29| 330, Boston, MA 02110-1301, USA. 30| 31 ======================================================================" 32 33 34 35Namespace current: NetClients.FTP [ 36 37Object subclass: FTPServerEntity [ 38 | permissions id owner group sizeInBytes modifiedDate filename isDirectory | 39 40 <category: 'NetClients-FTP'> 41 <comment: nil> 42 43 filename [ 44 <category: 'accessing'> 45 ^filename 46 ] 47 48 filename: aValue [ 49 <category: 'accessing'> 50 filename := aValue 51 ] 52 53 group [ 54 <category: 'accessing'> 55 ^group 56 ] 57 58 group: aValue [ 59 <category: 'accessing'> 60 group := aValue 61 ] 62 63 id [ 64 <category: 'accessing'> 65 ^id 66 ] 67 68 id: aValue [ 69 <category: 'accessing'> 70 id := aValue asNumber 71 ] 72 73 isDirectory [ 74 <category: 'accessing'> 75 ^isDirectory 76 ] 77 78 isDirectory: aValue [ 79 <category: 'accessing'> 80 isDirectory := aValue 81 ] 82 83 modifiedDate [ 84 <category: 'accessing'> 85 ^modifiedDate 86 ] 87 88 modifiedDate: aValue [ 89 <category: 'accessing'> 90 modifiedDate := aValue 91 ] 92 93 owner [ 94 <category: 'accessing'> 95 ^owner 96 ] 97 98 owner: aValue [ 99 <category: 'accessing'> 100 owner := aValue 101 ] 102 103 permissions [ 104 <category: 'accessing'> 105 ^permissions 106 ] 107 108 permissions: aValue [ 109 <category: 'accessing'> 110 permissions := aValue 111 ] 112 113 sizeInBytes [ 114 <category: 'accessing'> 115 ^sizeInBytes 116 ] 117 118 sizeInBytes: aValue [ 119 <category: 'accessing'> 120 sizeInBytes := aValue asNumber 121 ] 122 123 displayString [ 124 <category: 'displaying'> 125 | stream | 126 stream := Stream on: (String new: 100). 127 self isDirectory 128 ifTrue: [stream nextPutAll: ' <D> '] 129 ifFalse: [stream space: 5]. 130 stream 131 nextPutAll: self filename; 132 space: 30 - self filename size. 133 stream nextPutAll: self sizeInBytes printString. 134 ^stream contents 135 ] 136 137 from: stream [ 138 <category: 'initialize-release'> 139 self permissions: (stream upTo: Character space). 140 stream skipSeparators. 141 self id: (stream upTo: Character space). 142 stream skipSeparators. 143 self owner: (stream upTo: Character space). 144 stream skipSeparators. 145 self group: (stream upTo: Character space). 146 stream skipSeparators. 147 self sizeInBytes: (stream upTo: Character space). 148 stream skipSeparators. 149 self modifiedDate: (self getDateFromNext: 3 on: stream). 150 stream skipSeparators. 151 self filename: (stream upTo: Character space). 152 self isDirectory: self sizeInBytes = 0 153 ] 154 155 getDateFromNext: aNumber on: stream [ 156 <category: 'private'> 157 | iStream | 158 iStream := WriteStream on: (String new: 100). 159 aNumber timesRepeat: 160 [iStream nextPutAll: (stream upTo: Character space). 161 iStream nextPut: Character space. 162 stream skipSeparators]. 163 ^DateTime readFrom: iStream contents readStream 164 ] 165] 166 167] 168 169 170 171Namespace current: NetClients.FTP [ 172 173NetClient subclass: FTPClient [ 174 | loggedInUser | 175 176 <comment: ' 177Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved. 178'> 179 <category: 'NetClients-FTP'> 180 181 FTPClient class >> defaultPortNumber [ 182 <category: 'constants'> 183 ^21 184 ] 185 186 FTPClient class >> exampleHost: host [ 187 "self exampleHost: 'localhost'." 188 189 <category: 'examples'> 190 ^self exampleHost: host port: 21 191 ] 192 193 FTPClient class >> exampleHost: host port: port [ 194 "self exampleHost: 'localhost' port: 2121." 195 196 <category: 'examples'> 197 | user password stream client | 198 user := 'utente'. 199 password := 'bonzini'. 200 stream := WriteStream on: (String new: 256). 201 client := FTPClient connectToHost: host port: port. 202 203 [client 204 username: user password: password; 205 login; 206 getList: '/' into: stream] 207 ensure: [client close]. 208 ^stream contents 209 ] 210 211 FTPClient class >> exampleHost: host fileName: fileName [ 212 "self exampleHost: 'localhost'." 213 214 <category: 'examples'> 215 ^self 216 exampleHost: host 217 port: 21 218 fileName: fileName 219 ] 220 221 FTPClient class >> exampleHost: host port: port fileName: fileName [ 222 "self exampleHost: 'arrow' fileName: '/pub/smallwalker/README'." 223 224 <category: 'examples'> 225 | user password stream client | 226 user := 'utente'. 227 password := 'bonzini'. 228 stream := WriteStream on: (String new: 256). 229 client := FTPClient connectToHost: host port: port. 230 231 [client 232 username: user password: password; 233 login; 234 getFile: fileName 235 type: #ascii 236 into: stream] 237 ensure: [client close]. 238 ^stream contents 239 ] 240 241 protocolInterpreter [ 242 <category: 'private'> 243 ^FTPProtocolInterpreter 244 ] 245 246 login [ 247 <category: 'ftp'> 248 self connectIfClosed. 249 loggedInUser = self user ifTrue: [^self]. 250 self clientPI ftpUser: self user username. 251 self clientPI ftpPassword: self user password. 252 loggedInUser := self user 253 ] 254 255 logout [ 256 <category: 'ftp'> 257 loggedInUser := nil. 258 (self clientPI) 259 ftpQuit; 260 close 261 ] 262 263 getFile: fileName type: type into: aStream [ 264 <category: 'ftp'> 265 | fname directory tail | 266 self login. 267 fname := File path: fileName. 268 directory := fname path asString. 269 tail := fname stripPath asString. 270 tail isEmpty 271 ifTrue: 272 [^self clientPI 273 getDataWithType: type 274 into: aStream 275 do: [self clientPI ftpRetrieve: fileName]] 276 ifFalse: 277 [self clientPI ftpCwd: directory. 278 ^self clientPI 279 getDataWithType: type 280 into: aStream 281 do: [self clientPI ftpRetrieve: tail]] 282 ] 283 284 getList: pathName into: aStream [ 285 <category: 'ftp'> 286 | fname directory tail | 287 self login. 288 fname := File path: pathName. 289 directory := fname path asString. 290 tail := fname stripPath asString. 291 self clientPI ftpCwd: directory. 292 ^self clientPI 293 getDataWithType: #ascii 294 into: aStream 295 do: 296 [tail isEmpty 297 ifTrue: [self clientPI ftpList] 298 ifFalse: [self clientPI ftpList: tail]. 299 0] 300 ] 301] 302 303] 304 305 306 307Namespace current: NetClients.FTP [ 308 309NetProtocolInterpreter subclass: FTPProtocolInterpreter [ 310 311 <import: Sockets> 312 <comment: nil> 313 <category: 'NetClients-FTP'> 314 315 openDataConnectionDo: controlBlock [ 316 <category: 'data connection'> 317 "Create a socket. Set up a queue for a single connection." 318 319 | portSocket dataStream | 320 portSocket := ServerSocket 321 reuseAddr: true 322 port: 0 323 queueSize: 1 324 bindTo: nil. 325 326 [self ftpPort: portSocket port host: portSocket address asByteArray. 327 328 "issue control command." 329 controlBlock value. 330 [(dataStream := portSocket accept) isNil] whileTrue: [Processor yield]] 331 ensure: [portSocket close]. 332 ^dataStream 333 ] 334 335 openPassiveDataConnectionDo: controlBlock [ 336 <category: 'data connection'> 337 "Enter Passive Mode" 338 339 | array dataSocket dataStream | 340 array := self ftpPassive. 341 dataStream := Socket remote: (IPAddress fromBytes: (array at: 1)) 342 port: (array at: 2). 343 344 "issue control command." 345 controlBlock value. 346 ^dataStream 347 ] 348 349 connect [ 350 <category: 'ftp protocol'> 351 super connect. 352 self checkResponse 353 ] 354 355 getDataWithType: type into: aStream do: controlBlock [ 356 <category: 'ftp protocol'> 357 | dataStream totalByte coll | 358 (#(#ascii #binary) includes: type) 359 ifFalse: [^self error: 'type must be #ascii or #binary']. 360 type == #ascii ifTrue: [self ftpTypeAscii] ifFalse: [self ftpTypeBinary]. 361 362 "dataStream := self openDataConnectionDo: [totalByte := controlBlock value]." 363 dataStream := self 364 openPassiveDataConnectionDo: [totalByte := controlBlock value]. 365 totalByte > 0 ifTrue: [self reporter totalByte: totalByte]. 366 self reporter startTransfer. 367 368 [[dataStream atEnd] whileFalse: 369 [| byte | 370 byte := dataStream nextAvailable: 1024. 371 self reporter readByte: byte size. 372 type == #ascii 373 ifTrue: [aStream nextPutAll: (self decode: byte)] 374 ifFalse: [aStream nextPutAll: byte]]] 375 ensure: [dataStream close]. 376 self reporter endTransfer 377 ] 378 379 ftpAbort [ 380 <category: 'ftp protocol'> 381 self 382 nextPutAll: 'ABOR'; 383 cr. 384 self checkResponse 385 ] 386 387 ftpCdup [ 388 "Change to Parent Directory" 389 390 <category: 'ftp protocol'> 391 self 392 nextPutAll: 'CDUP'; 393 cr. 394 self checkResponse 395 ] 396 397 ftpCwd: directory [ 398 "Change Working Directory" 399 400 <category: 'ftp protocol'> 401 self 402 nextPutAll: 'CWD ' , directory; 403 cr. 404 self checkResponse 405 ] 406 407 ftpList [ 408 <category: 'ftp protocol'> 409 self 410 nextPutAll: 'LIST'; 411 cr. 412 self checkResponse 413 ] 414 415 ftpList: pathName [ 416 <category: 'ftp protocol'> 417 self 418 nextPutAll: 'LIST ' , pathName; 419 cr. 420 self checkResponse 421 ] 422 423 ftpPassive [ 424 <category: 'ftp protocol'> 425 | response stream hostAddress port | 426 self 427 nextPutAll: 'PASV'; 428 cr. 429 response := self getResponse. 430 self checkResponse: response. 431 response status = 227 432 ifFalse: [^self unexpectedResponse: response]. 433 434 "227 Entering Passive Mode (h1,h2,h3,h4,p1,p2)" 435 stream := response statusMessage readStream. 436 hostAddress := ByteArray new: 4. 437 stream upTo: $(. 438 hostAddress at: 1 put: (Integer readFrom: stream). 439 stream skip: 1. 440 hostAddress at: 2 put: (Integer readFrom: stream). 441 stream skip: 1. 442 hostAddress at: 3 put: (Integer readFrom: stream). 443 stream skip: 1. 444 hostAddress at: 4 put: (Integer readFrom: stream). 445 stream skip: 1. 446 port := Integer readFrom: stream. 447 stream skip: 1. 448 port := (port bitShift: 8) + (Integer readFrom: stream). 449 ^Array with: hostAddress with: port 450 ] 451 452 ftpPassword: password [ 453 <category: 'ftp protocol'> 454 | response | 455 self 456 nextPutAll: 'PASS ' , password; 457 cr. 458 response := self getResponse. 459 self checkResponse: response 460 ifError: [self loginIncorrectError: response statusMessage] 461 ] 462 463 ftpPort: portInteger host: hostAddressBytes [ 464 <category: 'ftp protocol'> 465 self 466 nextPutAll: 'PORT '; 467 nextPutAll: (hostAddressBytes at: 1) printString; 468 nextPut: $,; 469 nextPutAll: (hostAddressBytes at: 2) printString; 470 nextPut: $,; 471 nextPutAll: (hostAddressBytes at: 3) printString; 472 nextPut: $,; 473 nextPutAll: (hostAddressBytes at: 4) printString; 474 nextPut: $,; 475 nextPutAll: ((portInteger bitShift: -8) bitAnd: 255) printString; 476 nextPut: $,; 477 nextPutAll: (portInteger bitAnd: 255) printString; 478 cr. 479 self checkResponse 480 ] 481 482 ftpQuit [ 483 <category: 'ftp protocol'> 484 self 485 nextPutAll: 'QUIT'; 486 cr. 487 self checkResponse 488 ] 489 490 ftpRetrieve: fileName [ 491 <category: 'ftp protocol'> 492 | response stream | 493 self 494 nextPutAll: 'RETR ' , fileName; 495 cr. 496 response := self getResponse. 497 self checkResponse: response. 498 499 "150 Opening data connection for file (398 bytes)." 500 stream := response statusMessage readStream. 501 stream skipTo: $(. 502 stream atEnd ifTrue: [^nil]. 503 ^Integer readFrom: stream 504 ] 505 506 ftpStore: fileName [ 507 <category: 'ftp protocol'> 508 self 509 nextPutAll: 'STOR ' , fileName; 510 cr. 511 self checkResponse 512 ] 513 514 ftpType: type [ 515 <category: 'ftp protocol'> 516 self 517 nextPutAll: 'TYPE ' , type; 518 cr. 519 self checkResponse 520 ] 521 522 ftpTypeAscii [ 523 <category: 'ftp protocol'> 524 ^self ftpType: 'A' 525 ] 526 527 ftpTypeBinary [ 528 <category: 'ftp protocol'> 529 ^self ftpType: 'I' 530 ] 531 532 ftpUser: user [ 533 <category: 'ftp protocol'> 534 self 535 nextPutAll: 'USER ' , user; 536 cr. 537 self checkResponse 538 ] 539 540 checkResponse: response ifError: errorBlock [ 541 <category: 'private'> 542 | status | 543 status := response status. 544 545 "Positive Preliminary reply" 546 status = 110 547 ifTrue: 548 ["Restart marker reply" 549 550 ^self]. 551 status = 120 552 ifTrue: 553 ["Service ready in nnn minutes" 554 555 ^self]. 556 status = 125 557 ifTrue: 558 ["Data connection already open" 559 560 ^self]. 561 status = 150 562 ifTrue: 563 ["File status okay" 564 565 ^self]. 566 567 "Positive Completion reply" 568 status = 200 569 ifTrue: 570 ["OK" 571 572 ^self]. 573 status = 202 574 ifTrue: 575 ["Command not implemented" 576 577 ^self]. 578 status = 211 579 ifTrue: 580 ["System status" 581 582 ^self]. 583 status = 212 584 ifTrue: 585 ["Directory status" 586 587 ^self]. 588 status = 213 589 ifTrue: 590 ["File status" 591 592 ^self]. 593 status = 214 594 ifTrue: 595 ["Help message" 596 597 ^self]. 598 status = 215 599 ifTrue: 600 ["NAME system type" 601 602 ^self]. 603 status = 220 604 ifTrue: 605 ["Service ready for new user" 606 607 ^self]. 608 status = 221 609 ifTrue: 610 ["Service closing control connection" 611 612 ^self]. 613 status = 225 614 ifTrue: 615 ["Data connection open" 616 617 ^self]. 618 status = 226 619 ifTrue: 620 ["Closing data connection" 621 622 ^self]. 623 status = 227 624 ifTrue: 625 ["Entering Passive Mode" 626 627 ^self]. 628 status = 230 629 ifTrue: 630 ["User logged in" 631 632 ^self]. 633 status = 250 634 ifTrue: 635 ["Requested file action okay" 636 637 ^self]. 638 status = 257 639 ifTrue: 640 ["'PATHNAME' created" 641 642 ^self]. 643 644 "Positive Intermediate reply" 645 status = 331 646 ifTrue: 647 ["User name okay" 648 649 ^self]. 650 status = 332 651 ifTrue: 652 ["Need account for login" 653 654 ^self]. 655 status = 350 656 ifTrue: 657 ["Requested file action pending" 658 659 ^self]. 660 661 "Transient Negative Completion reply" 662 status = 421 663 ifTrue: 664 ["Service not available" 665 666 ^errorBlock value]. 667 status = 425 668 ifTrue: 669 ["Can't open data connection" 670 671 ^errorBlock value]. 672 status = 426 673 ifTrue: 674 ["Connection closed" 675 676 ^errorBlock value]. 677 status = 450 678 ifTrue: 679 ["Requested file action not taken" 680 681 ^errorBlock value]. 682 status = 451 683 ifTrue: 684 ["Requested action aborted" 685 686 ^errorBlock value]. 687 status = 452 688 ifTrue: 689 ["Requested action not taken" 690 691 ^errorBlock value]. 692 693 "Permanent Negative Completion reply" 694 status = 500 695 ifTrue: 696 ["Syntax error" 697 698 ^errorBlock value]. 699 status = 501 700 ifTrue: 701 ["Syntax error" 702 703 ^errorBlock value]. 704 status = 502 705 ifTrue: 706 ["Command not implemented" 707 708 ^errorBlock value]. 709 status = 503 710 ifTrue: 711 ["Bad sequence of commands" 712 713 ^errorBlock value]. 714 status = 504 715 ifTrue: 716 ["Command not implemented" 717 718 ^errorBlock value]. 719 status = 530 720 ifTrue: 721 ["Not logged in" 722 723 ^self loginIncorrectError: response statusMessage]. 724 status = 532 725 ifTrue: 726 ["Need account for storing files" 727 728 ^errorBlock value]. 729 status = 550 730 ifTrue: 731 ["Requested action not taken" 732 733 ^self fileNotFoundError: response statusMessage]. 734 status = 551 735 ifTrue: 736 ["Requested action aborted" 737 738 ^errorBlock value]. 739 status = 552 740 ifTrue: 741 ["Requested file action aborted" 742 743 ^errorBlock value]. 744 status = 553 745 ifTrue: 746 ["Requested action not taken" 747 748 ^errorBlock value]. 749 750 "Unknown status" 751 ^errorBlock value 752 ] 753 754 fileNotFoundError: errorString [ 755 <category: 'private'> 756 ^FTPFileNotFoundError signal: errorString 757 ] 758] 759 760] 761 762 763 764Namespace current: NetClients.FTP [ 765 766NetClientError subclass: FTPFileNotFoundError [ 767 768 <comment: nil> 769 <category: 'NetClients-FTP'> 770] 771 772] 773 774