/usr/share/gnu-smalltalk/kernel/VFS.st is in gnu-smalltalk-common 3.2.5-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 | "======================================================================
|
| Virtual File System layer definitions
|
|
======================================================================"
"======================================================================
|
| Copyright 2002, 2005, 2007, 2008, 2009 Free Software Foundation, Inc.
| Written by Paolo Bonzini.
|
| This file is part of the GNU Smalltalk class library.
|
| The GNU Smalltalk class library is free software; you can redistribute it
| and/or modify it under the terms of the GNU Lesser General Public License
| as published by the Free Software Foundation; either version 2.1, or (at
| your option) any later version.
|
| The GNU Smalltalk class library is distributed in the hope that it will be
| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser
| General Public License for more details.
|
| You should have received a copy of the GNU Lesser General Public License
| along with the GNU Smalltalk class library; see the file COPYING.LIB.
| If not, write to the Free Software Foundation, 59 Temple Place - Suite
| 330, Boston, MA 02110-1301, USA.
|
======================================================================"
Namespace current: VFS [
FilePath subclass: FileWrapper [
| file |
<category: 'Streams-Files'>
<comment: 'FileWrapper gives information for
virtual files that refer to a real file on disk.'>
FileWrapper class >> initialize [
"Register the receiver with ObjectMemory"
<category: 'initializing'>
ObjectMemory addDependent: self.
]
FileWrapper class >> update: aspect [
"Private - Remove the files before quitting, and register the virtual
filesystems specified by the subclasses upon image load."
<category: 'initializing'>
aspect == #aboutToQuit ifTrue: [self broadcast: #release]
]
FileWrapper class >> on: file [
"Create an instance of this class representing the contents of the given
file, under the virtual filesystem fsName."
<category: 'instance creation'>
^self new file: file
]
= aFile [
"Answer whether the receiver represents the same file as the receiver."
<category: 'basic'>
^self class == aFile class and: [ self file = aFile file ]
]
hash [
"Answer a hash value for the receiver."
<category: 'basic'>
^self file hash
]
asString [
"Answer the string representation of the receiver's path."
<category: 'accessing'>
^self file asString
]
name [
"Answer the full path to the receiver."
<category: 'accessing'>
^self file name
]
isAbsolute [
"Answer whether the receiver identifies an absolute path."
^self file isAbsolute
]
full [
"Answer the size of the file identified by the receiver"
<category: 'delegation'>
self isAbsolute ifTrue: [ ^self ].
^self class on: self file full
]
mode [
"Answer the permission bits for the file identified by the receiver"
<category: 'delegation'>
^self file mode
]
mode: anInteger [
"Answer the permission bits for the file identified by the receiver"
<category: 'delegation'>
self file mode: anInteger
]
size [
"Answer the size of the file identified by the receiver"
<category: 'delegation'>
^self file size
]
lastAccessTime [
"Answer the last access time of the file identified by the receiver"
<category: 'delegation'>
^self file lastAccessTime
]
exists [
"Answer whether a file with the name contained in the receiver
does exist."
<category: 'testing'>
^self file exists
]
isAbsolute [
"Answer whether the receiver identifies an absolute path."
<category: 'testing'>
^self file isAbsolute
]
isReadable [
"Answer whether a file with the name contained in the receiver does exist
and is readable"
<category: 'testing'>
^self file isReadable
]
isWriteable [
"Answer whether a file with the name contained in the receiver does exist
and is writeable"
<category: 'testing'>
^self file isWriteable
]
isExecutable [
"Answer whether a file with the name contained in the receiver does exist
and is executable"
<category: 'testing'>
^self file isExecutable
]
isAccessible [
"Answer whether a directory with the name contained in the receiver does
exist and can be accessed"
<category: 'testing'>
^self file isAccessible
]
isDirectory [
"Answer whether a file with the name contained in the receiver
does exist identifies a directory."
<category: 'testing'>
^self file isDirectory
]
isSymbolicLink [
"Answer whether a file with the name contained in the receiver
does exist and identifies a symbolic link."
<category: 'testing'>
^self file isSymbolicLink
]
owner: ownerString group: groupString [
"Set the receiver's owner and group to be ownerString and groupString."
<category: 'accessing'>
self file owner: ownerString group: groupString
]
lastAccessTime: accessDateTime lastModifyTime: modifyDateTime [
"Update the timestamps of the file corresponding to the receiver, to be
accessDateTime and modifyDateTime."
<category: 'accessing'>
self file lastAccessTime: accessDateTime lastModifyTime: modifyDateTime
]
lastChangeTime [
"Answer the last change time of the file identified by the receiver
(the `last change time' has to do with permissions, ownership and the
like). On some operating systems, this could actually be the
file creation time."
<category: 'delegation'>
^self file lastChangeTime
]
creationTime [
"Answer the creation time of the file identified by the receiver.
On some operating systems, this could actually be the last change time
(the `last change time' has to do with permissions, ownership and the
like)."
<category: 'delegation'>
^self file creationTime
]
lastModifyTime [
"Answer the last modify time of the file identified by the receiver
(the `last modify time' has to do with the actual file contents)."
<category: 'delegation'>
^self file lastModifyTime
]
isReadable [
"Answer whether a file with the name contained in the receiver does exist
and is readable"
<category: 'delegation'>
^self file isReadable
]
isWriteable [
"Answer whether a file with the name contained in the receiver does exist
and is writeable"
<category: 'delegation'>
^self file isWritable
]
isExecutable [
"Answer whether a file with the name contained in the receiver does exist
and is executable"
<category: 'delegation'>
^self file isExecutable
]
open: class mode: mode ifFail: aBlock [
"Open the receiver in the given mode (as answered by FileStream's
class constant methods)"
<category: 'delegation'>
^self file
open: class
mode: mode
ifFail: aBlock
]
remove [
"Remove the file with the given path name"
<category: 'delegation'>
self file remove
]
symlinkAs: destName [
"Create destName as a symbolic link of the receiver. The appropriate
relative path is computed automatically."
<category: 'file operations'>
^self file symlinkAs: destName
]
pathFrom: dirName [
"Compute the relative path from the directory dirName to the receiver"
<category: 'file operations'>
^self file pathFrom: dirName
]
symlinkFrom: srcName [
"Create the receiver as a symbolic link from srcName (relative to the
path of the receiver)."
<category: 'file operations'>
^self file symlinkFrom: srcName
]
renameTo: newName [
"Rename the file identified by the receiver to newName"
<category: 'file operations'>
^self file renameTo: newName
]
pathTo: destName [
"Compute the relative path from the receiver to destName."
<category: 'accessing'>
^self file pathTo: destName
]
at: aName [
"Answer a File or Directory object as appropriate for a file named
'aName' in the directory represented by the receiver."
<category: 'accessing'>
^self class on: (self file at: aName)
]
namesDo: aBlock [
"Evaluate aBlock once for each file in the directory represented by the
receiver, passing its name."
<category: 'enumerating'>
self file namesDo: aBlock
]
file [
<category: 'private'>
^file
]
file: aFilePath [
<category: 'private'>
file := aFilePath.
]
]
]
Namespace current: Kernel [
VFS.FileWrapper subclass: RecursiveFileWrapper [
<category: 'Streams-Files'>
do: aBlock [
"Same as the wrapped #do:, but reuses the file object for efficiency."
<category: 'enumerating'>
aBlock value: self file.
self file namesDo:
[:name |
| f |
(#('.' '..') includes: name) ifFalse: [
f := self at: name.
aBlock value: f file.
(f isDirectory and: [f isSymbolicLink not])
ifTrue: [f do: aBlock]]]
]
namesDo: aBlock prefixLength: anInteger [
"Same as the wrapped #namesDo:, but navigates the entire directory
tree recursively. Since the objects created by #at: also contain the
path to the receiver, anInteger is used to trim it."
<category: 'private'>
self file namesDo:
[:name |
| f |
(#('.' '..') includes: name) ifFalse: [
f := self at: name.
aBlock value: (f asString copyFrom: anInteger).
(f isDirectory and: [f isSymbolicLink not])
ifTrue: [f
namesDo: aBlock
prefixLength: anInteger ]]]
]
namesDo: aBlock [
"Same as the wrapped #namesDo:, but navigates the entire directory
tree recursively."
<category: 'enumerating'>
| n base |
aBlock value: '.'.
base := self asString.
n := base last = Directory pathSeparator
ifTrue: [ base size + 1 ]
ifFalse: [ base size + 2 ].
self namesDo: aBlock prefixLength: n
]
remove [
"Removes the entire directory tree recursively."
<category: 'file operations'>
self isDirectory ifTrue: [
self file namesDo:
[:name |
| f |
f := self at: name.
f isDirectory
ifTrue:
[((#('.' '..') includes: name) or: [f isSymbolicLink])
ifFalse: [f all remove]]
ifFalse: [f remove]]].
super remove
]
isFileSystemPath [
"Answer whether the receiver corresponds to a real filesystem path."
<category: 'testing'>
^self file isFileSystemPath
]
lastAccessTime: accessDateTime lastModifyTime: modifyDateTime [
"Update the timestamps of all files in the tree to be
accessDateTime and modifyDateTime."
<category: 'accessing'>
self isDirectory ifFalse: [
^super lastAccessTime: accessDateTime lastModifyTime: modifyDateTime ].
self do: [ :each |
each lastAccessTime: accessDateTime lastModifyTime: modifyDateTime ]
]
owner: ownerString group: groupString [
"Set the owner and group for all files and directories in the tree."
<category: 'accessing'>
self isDirectory ifFalse: [
^super owner: ownerString group: groupString ].
"These special calls cache the uid and gid to avoid repeated lookups."
[
File setOwnerFor: nil owner: ownerString group: groupString.
self do: [ :each | each owner: ownerString group: groupString ]
] ensure: [ File setOwnerFor: nil owner: nil group: nil ]
]
mode: anInteger [
"Set the mode to be anInteger for all files in the tree. Directory
modes are left unchanged."
<category: 'accessing'>
self isDirectory ifFalse: [ ^super mode: anInteger ].
self do: [ :each | each isDirectory ifFalse: [ each mode: anInteger ] ]
]
fileMode: fMode directoryMode: dMode [
"Set the mode to be fMode for all files in the tree, and dMode for
all directories in the tree."
<category: 'accessing'>
self isDirectory ifFalse: [ ^super mode: fMode ].
super mode: dMode.
self isDirectory ifTrue: [
self do: [ :each |
each mode: (each isDirectory
ifTrue: [ dMode ]
ifFalse: [ fMode ]) ] ]
]
]
]
Namespace current: VFS [
FileWrapper subclass: ArchiveFile [
| tmpFiles topLevelFiles allFiles extractedFiles |
<category: 'Streams-Files'>
<comment: 'ArchiveFile handles
virtual filesystems that have a directory structure of
their own. The directories and files in the archive are
instances of ArchiveMember, but the functionality
resides entirely in ArchiveFile because the members
will still ask the archive to get directory information
on them, to extract them to a real file, and so on.'>
displayOn: aStream [
"Print a representation of the file identified by the receiver."
super displayOn: aStream.
aStream nextPut: $#.
self class printOn: aStream
]
isDirectory [
"Answer true. The archive can always be considered as a directory."
<category: 'querying'>
^true
]
isAccessible [
"Answer whether a directory with the name contained in the receiver does
exist and can be accessed"
<category: 'querying'>
^self isReadable
]
at: aName [
"Answer a FilePath for a file named `aName' residing in the directory
represented by the receiver."
<category: 'directory operations'>
| handler data |
allFiles isNil ifTrue: [self refresh].
data := allFiles at: aName ifAbsent: [^nil].
handler := data at: 5 ifAbsent: [nil].
handler isNil ifFalse: [^handler].
tmpFiles isNil
ifTrue:
[tmpFiles := LookupTable new.
FileWrapper addDependent: self.
self addToBeFinalized].
^tmpFiles at: aName
ifAbsentPut:
[(TmpFileArchiveMember new)
name: aName;
archive: self]
]
nameAt: aString [
"Answer a FilePath for a file named `aName' residing in the directory
represented by the receiver."
<category: 'directory operations'>
^aString
]
namesDo: aBlock [
"Evaluate aBlock once for each file in the directory represented by the
receiver, passing its name."
<category: 'directory operations'>
topLevelFiles isNil ifTrue: [self refresh].
topLevelFiles do: aBlock
]
release [
"Release the resources used by the receiver that don't survive when
reloading a snapshot."
<category: 'directory operations'>
tmpFiles isNil
ifFalse:
[tmpFiles do: [:each | each release].
tmpFiles := nil].
extractedFiles isNil
ifFalse:
[extractedFiles do: [:each | self primUnlink: each].
extractedFiles := nil].
super release
]
fillMember: anArchiveMember [
"Extract the information on anArchiveMember. Answer
false if it actually does not exist in the archive; otherwise,
answer true after having told anArchiveMember about them
by sending #size:stCtime:stMtime:stAtime:isDirectory: to it."
<category: 'ArchiveMember protocol'>
| data |
allFiles isNil ifTrue: [self refresh].
data := allFiles at: anArchiveMember name ifAbsent: [nil].
data isNil ifTrue: [^false].
anArchiveMember fillFrom: data.
^true
]
member: anArchiveMember do: aBlock [
"Evaluate aBlock once for each file in the directory represented by
anArchiveMember, passing its name."
<category: 'ArchiveMember protocol'>
| data |
allFiles isNil ifTrue: [self refresh].
data := allFiles at: anArchiveMember name ifAbsent: [nil].
data isNil ifTrue: [^SystemExceptions.FileError signal: 'File not found'].
(data at: 1) isNil
ifTrue: [^SystemExceptions.FileError signal: 'Not a directory'].
(data at: 1) do: aBlock
]
refresh [
"Extract the directory listing from the archive"
<category: 'ArchiveMember protocol'>
| pipe line parentPath name current currentPath directoryTree directory |
super refresh.
current := currentPath := nil.
allFiles := LookupTable new.
directoryTree := LookupTable new.
self fileData do:
[:data |
| path size date mode member |
mode := self convertMode: (data at: 4).
data at: 4 put: mode.
path := data at: 1.
path last = $/ ifTrue: [path := path copyFrom: 1 to: path size - 1].
"Look up the tree for the directory in which the file resides.
We keep a simple 1-element cache."
parentPath := File pathFor: path.
name := File stripPathFrom: path.
parentPath = currentPath
ifFalse:
[currentPath := parentPath.
current := self findDirectory: path into: directoryTree].
"Create an item in the tree for directories, and
add an association to the allFiles SortedCollection"
directory := (mode bitAnd: 8r170000) = 8r40000
ifTrue: [current at: name put: LookupTable new]
ifFalse: [current at: name put: nil].
data at: 1 put: directory.
allFiles at: path put: data.
member := data at: 5 ifAbsent: [nil].
member notNil ifTrue: [member fillFrom: data]].
"Leave the LookupTables to be garbage collected, we are now interested
in the file names only."
topLevelFiles := directoryTree keys asArray.
allFiles
do: [:data | (data at: 1) isNil ifFalse: [data at: 1 put: (data at: 1) keys asArray]]
]
member: anArchiveMember mode: bits [
"Set the permission bits for the file in anArchiveMember."
<category: 'ArchiveMember protocol'>
self subclassResponsibility
]
removeMember: anArchiveMember [
"Remove the member represented by anArchiveMember."
<category: 'ArchiveMember protocol'>
self subclassResponsibility
]
updateMember: anArchiveMember [
"Update the member represented by anArchiveMember by
copying the file into which it was extracted back to the
archive."
<category: 'ArchiveMember protocol'>
self subclassResponsibility
]
extractMember: anArchiveMember [
"Extract the contents of anArchiveMember into a file
that resides on disk, and answer the name of the file."
<category: 'TmpFileArchiveMember protocol'>
extractedFiles isNil ifTrue: [extractedFiles := IdentityDictionary new].
^extractedFiles at: anArchiveMember
ifAbsentPut:
[| temp |
temp := FileStream openTemporaryFile: Directory temporary , '/vfs'.
self extractMember: anArchiveMember into: temp.
File name: temp name]
]
extractMember: anArchiveMember into: file [
"Extract the contents of anArchiveMember into a file
that resides on disk, and answer the name of the file."
<category: 'TmpFileArchiveMember protocol'>
self subclassResponsibility
]
convertMode: mode [
"Convert the mode from a string, character or boolean to an octal number."
<category: 'private'>
mode isNumber ifTrue: [^mode].
mode isString ifTrue: [^self convertModeString: mode].
mode isCharacter ifTrue: [^self convertMode: mode == $d].
^mode ifTrue: [8r40755] ifFalse: [8r644]
]
convertModeString: modeString [
"Convert the mode from a string to an octal number."
<category: 'private'>
| mode |
mode := 0.
(modeString at: 1) = $l ifTrue: [mode := 8r120000].
(modeString at: 1) = $d ifTrue: [mode := 8r40000].
(modeString at: 4) asLowercase = $s ifTrue: [mode := mode + 8r4000].
(modeString at: 7) asLowercase = $s ifTrue: [mode := mode + 8r2000].
(modeString at: 10) asLowercase = $t ifTrue: [mode := mode + 8r1000].
modeString
from: 2
to: 10
keysAndValuesDo: [:i :ch | ch isLowercase ifTrue: [mode := mode setBit: 11 - i]].
^mode
]
findDirectory: path into: tree [
"Look up into tree (which is a tree of Dictionaries) the directory
that is the parent of the file named `path'."
<category: 'private'>
| current last |
current := tree.
last := 1.
path keysAndValuesDo:
[:i :each |
| element |
each = $/
ifTrue:
[last = i
ifFalse:
[element := path copyFrom: last to: i - 1.
current := current at: element
ifAbsentPut:
["The list command might output files but not
directories. No problem, we create them along
the way."
| directory |
directory := LookupTable new.
allFiles at: (path copyFrom: 1 to: i - 1)
put:
{directory. 0.
self creationTime.
self mode bitOr: 8r40111}.
directory]].
last := i + 1]].
^current
]
]
]
Namespace current: VFS [
FilePath subclass: ArchiveMember [
| archive name mode size stCtime stMtime stAtime |
<category: 'Streams-Files'>
<comment: 'TmpFileArchiveMember is a handler
class for members of archive files that creates temporary files when
extracting files from an archive.'>
= aFile [
"Answer whether the receiver represents the same file as the receiver."
<category: 'basic'>
^self class == aFile class and: [ self archive = aFile archive
and: [ self name = aFile name ] ]
]
hash [
"Answer a hash value for the receiver."
<category: 'basic'>
^self archive hash bitXor: self name hash
]
archive: anArchiveFile [
"Set the archive of which the receiver is a member."
<category: 'initializing'>
archive := anArchiveFile
]
full [
"Answer the size of the file identified by the receiver"
<category: 'delegation'>
^self archive full at: self name
]
fillFrom: data [
"Called back by the receiver's archive when the ArchiveMember
asks for file information."
<category: 'initializing'>
self
size: (data at: 2)
stMtime: (data at: 3)
mode: (data at: 4)
]
size: bytes stMtime: mtime mode: modeBits [
"Set the file information for the receiver."
<category: 'initializing'>
size := bytes.
stCtime := self archive lastModifyTime.
stMtime := mtime.
stAtime := self archive lastAccessTime.
mode := modeBits
]
size: bytes stCtime: ctime stMtime: mtime stAtime: atime mode: modeBits [
"Set the file information for the receiver."
<category: 'initializing'>
size := bytes.
stCtime := ctime.
stMtime := mtime.
stAtime := atime.
mode := modeBits
]
asString [
"Answer the name of the file identified by the receiver as answered by
File>>#name."
<category: 'accessing'>
^self name
]
displayOn: aStream [
"Print a representation of the file identified by the receiver."
self archive displayOn: aStream.
aStream nextPut: $/.
super displayOn: aStream
]
isAbsolute [
"Answer whether the receiver identifies an absolute path."
^self archive isAbsolute
]
name [
"Answer the receiver's file name."
<category: 'accessing'>
^name
]
name: aName [
"Set the receiver's file name to aName."
<category: 'accessing'>
name := aName
]
archive [
"Answer the archive of which the receiver is a member."
<category: 'accessing'>
^archive
]
size [
"Answer the size of the file identified by the receiver"
<category: 'accessing'>
size isNil ifTrue: [self refresh].
^size
]
lastAccessTime [
"Answer the last access time of the file identified by the receiver"
<category: 'accessing'>
stAtime isNil ifTrue: [self refresh].
^stAtime
]
lastChangeTime [
"Answer the last change time of the file identified by the receiver
(the `last change time' has to do with permissions, ownership and the
like). On some operating systems, this could actually be the
file creation time."
<category: 'accessing'>
stCtime isNil ifTrue: [self refresh].
^stCtime
]
creationTime [
"Answer the creation time of the file identified by the receiver.
On some operating systems, this could actually be the last change time
(the `last change time' has to do with permissions, ownership and the
like)."
<category: 'accessing'>
stCtime isNil ifTrue: [self refresh].
^stCtime
]
lastModifyTime [
"Answer the last modify time of the file identified by the receiver
(the `last modify time' has to do with the actual file contents)."
<category: 'accessing'>
stMtime isNil ifTrue: [self refresh].
^stMtime
]
refresh [
"Refresh the statistics for the receiver"
<category: 'accessing'>
self archive fillMember: self
]
exists [
"Answer whether a file with the name contained in the receiver does exist."
<category: 'testing'>
^self archive fillMember: self
]
mode [
"Answer the octal permissions for the file."
<category: 'testing'>
size isNil ifTrue: [self refresh].
^mode bitAnd: 4095
]
mode: mode [
"Set the octal permissions for the file to be `mode'."
<category: 'testing'>
self archive member: self mode: (mode bitAnd: 4095)
]
isSymbolicLink [
"Answer whether a file with the name contained in the receiver does exist
and identifies a symbolic link."
<category: 'testing'>
size isNil ifTrue: [self refresh].
^(mode bitAnd: 8r170000) = 8r120000
]
isDirectory [
"Answer whether a file with the name contained in the receiver does exist
and identifies a directory."
<category: 'testing'>
size isNil ifTrue: [self refresh].
^(mode bitAnd: 8r170000) = 8r40000
]
isReadable [
"Answer whether a file with the name contained in the receiver does exist
and is readable"
<category: 'testing'>
^true
]
isWriteable [
"Answer whether a file with the name contained in the receiver does exist
and is writeable"
<category: 'testing'>
^true
]
isExecutable [
"Answer whether a file with the name contained in the receiver does exist
and is executable"
<category: 'testing'>
^false
]
isAccessible [
"Answer whether a directory with the name contained in the receiver does exist
and is accessible"
<category: 'testing'>
^true
]
open: class mode: mode ifFail: aBlock [
"Open the receiver in the given mode (as answered by FileStream's
class constant methods)"
<category: 'file operations'>
self subclassResponsibility
]
update: aspect [
"Private - Update the in-archive version of the file before closing."
<category: 'file operations'>
aspect == #beforeClosing
ifTrue: [self archive updateMember: self] aspect == #afterClosing
ifTrue:
[self archive refresh.
self refresh]
]
remove [
"Remove the file with the given path name"
<category: 'file operations'>
self archive removeMember: self.
File checkError
]
renameTo: newFileName [
"Rename the file with the given path name oldFileName to newFileName"
<category: 'file operations'>
self notYetImplemented
]
at: aName [
"Answer a FilePath for a file named `aName' residing in the directory
represented by the receiver."
<category: 'directory operations'>
^self archive at: (File append: aName to: self name)
]
, aName [
"Answer an object of the same kind as the receiver, whose name
is suffixed with aName."
^self archive at: (self name, aName)
]
createDirectory: dirName [
"Create a subdirectory of the receiver, naming it dirName."
<category: 'directory operations'>
self archive createDirectory: (File append: dirName to: self name)
]
namesDo: aBlock [
"Evaluate aBlock once for each file in the directory represented by the
receiver, passing its name."
<category: 'directory operations'>
self archive member: self do: aBlock
]
]
]
Namespace current: VFS [
ArchiveMember subclass: TmpFileArchiveMember [
| file |
<category: 'Streams-Files'>
<comment: nil>
release [
"Release the resources used by the receiver that don't survive when
reloading a snapshot."
"Remove the file that was temporarily holding the file contents"
<category: 'finalization'>
self extracted ifTrue: [ file remove. file := nil ].
super release
]
open: class mode: mode ifFail: aBlock [
"Open the receiver in the given mode (as answered by FileStream's
class constant methods)"
<category: 'directory operations'>
| fileStream |
self file isNil ifTrue: [^aBlock value].
fileStream := file open: class mode: mode ifFail: [^aBlock value].
mode == FileStream read ifFalse: [fileStream addDependent: self].
fileStream setFile: self.
^fileStream
]
extracted [
"Answer whether the file has already been extracted to disk."
^file notNil
]
file [
"Answer the real file name which holds the file contents,
or nil if it does not apply."
<category: 'directory operations'>
file isNil ifFalse: [^file].
self exists ifFalse: [^nil].
file := self archive extractMember: self.
^file
]
]
]
|