diff --git a/src/System-OSEnvironments-Tests/OSEnvironmentTest.class.st b/src/System-OSEnvironments-Tests/OSEnvironmentTest.class.st index 26fcf81eb0f..a5ad6a80610 100644 --- a/src/System-OSEnvironments-Tests/OSEnvironmentTest.class.st +++ b/src/System-OSEnvironments-Tests/OSEnvironmentTest.class.st @@ -55,29 +55,6 @@ OSEnvironmentTest >> testAtPut [ self deny: (env includesKey: key) ] -{ #category : 'tests' } -OSEnvironmentTest >> testEnvironmentFor [ - - | compareDictionary | - - compareDictionary := ((Smalltalk hasClassNamed: #UnixEnvironment) and: [Smalltalk hasClassNamed: #Win32Environment]) - ifTrue: [ "NativeBoost is present in the image" - { MacOSPlatform -> #UnixEnvironment. - MacOSXPlatform -> #UnixEnvironment. - UnixPlatform -> #UnixEnvironment. - Win32Platform -> #Win32Environment } asDictionary ] - ifFalse: [ "NativeBoost is NOT present in the image" - { MacOSPlatform -> #NullOSEnvironment. - MacOSXPlatform -> #NullOSEnvironment. - UnixPlatform -> #NullOSEnvironment. - Win32Platform -> #NullOSEnvironment } asDictionary ]. - - compareDictionary keysAndValuesDo: [ :platformClass :envClassName | - self - assert: (OSEnvironment environmentFor: platformClass new) class name - equals: envClassName ] -] - { #category : 'tests' } OSEnvironmentTest >> testKeys [ | env keys | diff --git a/src/System-OSEnvironments/AbstractUnixPlatform.extension.st b/src/System-OSEnvironments/AbstractUnixPlatform.extension.st new file mode 100644 index 00000000000..ea6b06924f1 --- /dev/null +++ b/src/System-OSEnvironments/AbstractUnixPlatform.extension.st @@ -0,0 +1,161 @@ +Extension { #name : 'AbstractUnixPlatform' } + +{ #category : '*System-OSEnvironments' } +AbstractUnixPlatform >> at: aKey encoding: anEncoding ifAbsent: aBlock [ + "Gets the value of an environment variable called `aKey`. + Execute aBlock if absent. + Use `anEncoding` to encode the arguments and return values. + + This is a *nix specific API. + Rationale: In *nix systems (compared to windows systems) environment variables are stored as raw bytes and can be encoded in different forms." + + | result | + result := self rawAt: (aKey encodeWith: anEncoding) ifAbsent: [ ^ aBlock value ]. + ^ result decodeWith: anEncoding +] + +{ #category : '*System-OSEnvironments' } +AbstractUnixPlatform >> at: aKey put: aValue encoding: anEncoding [ + "Sets the value of an environment variable called `aKey` to `aValue`. + Use `anEncoding` to encode both arguments. + + This is a *nix specific API. + Rationale: In *nix systems (compared to windows systems) environment variables are stored as raw bytes and can be encoded in different forms." + + ^ self rawAt: (aKey encodeWith: anEncoding) put: (aValue encodeWith: anEncoding) +] + +{ #category : '*System-OSEnvironments' } +AbstractUnixPlatform >> basicGetEnvRaw: encodedVariableName [ + + "PRIVATE: This primitive call works on Strings, while the correct way to manage encodings is with raw data. + Use me through #rawAt: to correctly marshall data." + + "Gets the value of an environment variable called `anEncodedVariableName` already encoded but in ByteString form." + + + ec ifNil: [ ^ (self basicGetEnvRawViaFFI: encodedVariableName asString) asByteArray]. + self primitiveFail +] + +{ #category : '*System-OSEnvironments' } +AbstractUnixPlatform >> basicGetEnvRawViaFFI: arg1 [ + + "PRIVATE: This FFI call works on Strings, while the correct way to manage encodings is with raw data. + Use me through #basicGetEnvRaw: to correctly marshall data." + + "This method calls the Standard C Library getenv() function. + The name of the argument (arg1) should fit decompiled version." + + ^ self ffiCall: #( String getenv (String arg1) ) module: LibC +] + +{ #category : '*System-OSEnvironments' } +AbstractUnixPlatform >> environ [ + "Return the address of the array holding the environment variables" + + ^ FFIExternalArray fromPointer: (ExternalAddress loadSymbol: 'environ' from: LibC) type: String +] + +{ #category : '*System-OSEnvironments' } +AbstractUnixPlatform >> environAt: index [ + + ^ self environ at: index +] + +{ #category : '*System-OSEnvironments' } +AbstractUnixPlatform >> environmentVariableNamed: aKey ifAbsent: aBlock [ + "See super + Uses a single encoding determined dynamically" + + ^ self at: aKey encoding: self defaultEncoding ifAbsent: aBlock +] + +{ #category : '*System-OSEnvironments' } +AbstractUnixPlatform >> environmentVariableNamed: aKey put: aValue [ + "See super + Uses a single encoding determined dynamically" + + ^ self at: aKey put: aValue encoding: self defaultEncoding +] + +{ #category : '*System-OSEnvironments' } +AbstractUnixPlatform >> environmentVariablesDo: aBlock [ + + | index associationString | + index := 1. + [ + associationString := self environAt: index. + associationString ifNil: [ ^ self ]. + self keysAndValuesDo: aBlock withAssociationString: associationString. + index := index + 1 ] repeat +] + +{ #category : '*System-OSEnvironments' } +AbstractUnixPlatform >> rawAt: anEncodedKey ifAbsent: aBlock [ + "Gets the value of an environment variable called `anEncodedKey` that is already encoded (i.e., it is a byte array). + Execute aBlock if absent. + + This is a *nix specific API. + Rationale: In *nix systems (compared to windows systems) environment variables are stored as raw bytes and can be encoded in different forms." + + | rawValue | + rawValue := self basicGetEnvRaw: anEncodedKey asString. + ^ rawValue + ifNil: [ aBlock value ] + ifNotNil: [ rawValue asByteArray ] +] + +{ #category : '*System-OSEnvironments' } +AbstractUnixPlatform >> rawAt: anEncodedKey put: someBytes [ + "Sets the value of an environment variable called `anEncodedKey` to `someBytes`. + Both arguments should be already encoded (i.e., they are byte arrays). + + This is a *nix specific API. + Rationale: In *nix systems (compared to windows systems) environment variables are stored as raw bytes and can be encoded in different forms." + + ^ self setEnv: anEncodedKey asString value: someBytes asString +] + +{ #category : '*System-OSEnvironments' } +AbstractUnixPlatform >> rawRemoveKey: anEncodedKey [ + "Removes an environment variable called `anEncodedKey` that is already encoded (i.e., it is a byte array). + + This is a *nix specific API. + Rationale: In *nix systems (compared to windows systems) environment variables are stored as raw bytes and can be encoded in different forms." + + ^ self unsetEnv: anEncodedKey asString +] + +{ #category : '*System-OSEnvironments' } +AbstractUnixPlatform >> removeEnvironmentVariableNamed: key [ + "See super + Uses a single encoding determined dynamically" + + ^ self removeKey: key encoded: self defaultEncoding +] + +{ #category : '*System-OSEnvironments' } +AbstractUnixPlatform >> removeKey: key encoded: anEncoding [ + "Removes the entry `aKey` from the environment variables. + Use `anEncoding` to encode the arguments. + + This is a *nix specific API. + Rationale: In *nix systems (compared to windows systems) environment variables are stored as raw bytes and can be encoded in different forms." + + ^ self rawRemoveKey: (key encodeWith: anEncoding) +] + +{ #category : '*System-OSEnvironments' } +AbstractUnixPlatform >> setEnv: nameString value: valueString [ + "int setenv(const char *name, const char *value, int overwrite);" + + ^ self ffiCall: #( int setenv #( String nameString #, String valueString #, int 1 ) ) module: LibC +] + +{ #category : '*System-OSEnvironments' } +AbstractUnixPlatform >> unsetEnv: string [ + "This method calls the the platform specific unset environment routine" + + ^ self ffiCall: #(int unsetenv #(String string)) module: LibC +] diff --git a/src/System-OSEnvironments/NullOSEnvironment.class.st b/src/System-OSEnvironments/NullOSEnvironment.class.st deleted file mode 100644 index fd36817432a..00000000000 --- a/src/System-OSEnvironments/NullOSEnvironment.class.st +++ /dev/null @@ -1,46 +0,0 @@ -" -I'm a platform independent environment who is intent to work as fallback when none other works. -I provide stubs for method calls that answers just default values. - -" -Class { - #name : 'NullOSEnvironment', - #superclass : 'OSEnvironment', - #category : 'System-OSEnvironments-Platforms', - #package : 'System-OSEnvironments', - #tag : 'Platforms' -} - -{ #category : 'testing' } -NullOSEnvironment class >> isAvailable [ - - ^ true -] - -{ #category : 'accessing' } -NullOSEnvironment >> at: aKey ifAbsent: aBlock [ - "Gets the value of an environment variable called `aKey`. Execute aBlock if absent. - As there is nowhere to look up the key just evaluate the given block" - - ^ aBlock value -] - -{ #category : 'accessing' } -NullOSEnvironment >> at: aKey put: aValue [ - "Do nothing" -] - -{ #category : 'enumeration' } -NullOSEnvironment >> keysAndValuesDo: aBlock [ - "Do nothing" -] - -{ #category : 'accessing' } -NullOSEnvironment >> removeKey: key [ - "Do nothing" -] - -{ #category : 'accessing' } -NullOSEnvironment >> setEnv: nameString value: valueString [ - "We do not support environment Variables. Do Nothing" -] diff --git a/src/System-OSEnvironments/OSEnvironment.class.st b/src/System-OSEnvironments/OSEnvironment.class.st index 93bc5cb51de..879ef87a2f4 100644 --- a/src/System-OSEnvironments/OSEnvironment.class.st +++ b/src/System-OSEnvironments/OSEnvironment.class.st @@ -12,8 +12,6 @@ In other words, methods - #at:put: and its variants receive normal strings and decide whether they have to encode those strings to platform bytes or not depending on the platform. - -My subclasses may or may not provide additional APIs to have more control on the particular encoding used. " Class { #name : 'OSEnvironment', @@ -31,20 +29,7 @@ Class { { #category : 'instance creation' } OSEnvironment class >> current [ - ^ Current ifNil: [ Current := self environmentFor: OSPlatform current ] -] - -{ #category : 'private - accessing' } -OSEnvironment class >> environmentFor: aPlatform [ - | environmentClass | - - environmentClass := self allSubclasses - detect: [ :each | each isDefaultFor: aPlatform ] - ifNone: [ nil ]. - - ^ (environmentClass isNotNil and: [ environmentClass isAvailable ]) - ifTrue: [ environmentClass platform: aPlatform ] - ifFalse: [ NullOSEnvironment platform: aPlatform ] + ^ Current ifNil: [ Current := self platform: OSPlatform current ] ] { #category : 'examples' } @@ -59,18 +44,6 @@ OSEnvironment class >> initialize [ registerSystemClassNamed: self name ] -{ #category : 'testing' } -OSEnvironment class >> isAvailable [ - self flag: #pharoTodo. "Replace this for a check of FFI available" - self environment at: #FFICalloutAPI ifAbsent: [ ^ false ]. - ^ true -] - -{ #category : 'testing' } -OSEnvironment class >> isDefaultFor: aPlatform [ - ^ false -] - { #category : 'instance creation' } OSEnvironment class >> platform: anOSPlatform [ ^ self basicNew initializeWith: anOSPlatform @@ -126,7 +99,7 @@ OSEnvironment >> at: aKey ifAbsent: aBlock [ This is the common denominator API for all platforms. Rationale: Windows does not (compared to *nix systems) provide a encoded byte representation of the value. Windows has instead its own wide string representation." - self subclassResponsibility + ^ self platform environmentVariableNamed: aKey ifAbsent: aBlock ] { #category : 'accessing' } @@ -175,7 +148,7 @@ OSEnvironment >> at: aKey put: aValue [ This is the common denominator API for all platforms. Rationale: Windows does not (compared to *nix systems) provide a encoded byte representation of the value. Windows has instead its own wide string representation." - ^ self subclassResponsibility + ^ self platform environmentVariableNamed: aKey put: aValue ] { #category : 'enumeration' } @@ -211,16 +184,8 @@ OSEnvironment >> keys [ { #category : 'enumeration' } OSEnvironment >> keysAndValuesDo: aBlock [ - self subclassResponsibility -] -{ #category : 'enumeration' } -OSEnvironment >> keysAndValuesDo: aBlock withAssociationString: associationString [ - | equalsIndex | - equalsIndex := associationString indexOf: $=. - aBlock - value: (associationString first: equalsIndex-1) - value: (associationString allButFirst: equalsIndex) + ^ self platform environmentVariablesDo: aBlock ] { #category : 'enumeration' } @@ -242,14 +207,14 @@ OSEnvironment >> removeKey: aKey [ This is the common denominator API for all platforms. Rationale: Windows does not (compared to *nix systems) provide a encoded byte representation of the value. Windows has instead its own wide string representation." - ^ self subclassResponsibility + ^ self platform removeEnvironmentVariableNamed: aKey ] { #category : 'accessing' } OSEnvironment >> setEnv: nameString value: valueString [ "This method calls the the platform specific set environment routine" - ^ self subclassResponsibility + ^ self platform setEnv: nameString value: valueString ] { #category : 'accessing' } @@ -265,13 +230,6 @@ OSEnvironment >> setEnv: nameString value: valueString during: aBlock [ ifNotNil: [ self setEnv: nameString value: oldValue ] ] ] -{ #category : 'accessing' } -OSEnvironment >> unsetEnv: string [ - "This method calls the the platform specific unset environment routine" - - ^ self ffiCall: #(int unsetenv #(String string)) module: LibC -] - { #category : 'accessing' } OSEnvironment >> values [ "Answer a Collection containing the receiver's values." diff --git a/src/System-OSEnvironments/OSPlatform.extension.st b/src/System-OSEnvironments/OSPlatform.extension.st index f9cf284e969..7ecae3b990b 100644 --- a/src/System-OSEnvironments/OSPlatform.extension.st +++ b/src/System-OSEnvironments/OSPlatform.extension.st @@ -4,3 +4,46 @@ Extension { #name : 'OSPlatform' } OSPlatform >> environment [ ^ OSEnvironment current ] + +{ #category : '*System-OSEnvironments' } +OSPlatform >> environmentVariableNamed: aKey ifAbsent: aBlock [ + "Gets the value of an environment variable called `aKey`. Execute aBlock if absent. + As there is nowhere to look up the key just evaluate the given block" + + ^ aBlock value +] + +{ #category : '*System-OSEnvironments' } +OSPlatform >> environmentVariableNamed: aKey put: aValue [ + "Do nothing by default" + + +] + +{ #category : '*System-OSEnvironments' } +OSPlatform >> environmentVariablesDo: aBlock [ + "Nothing by default" + + +] + +{ #category : '*System-OSEnvironments' } +OSPlatform >> keysAndValuesDo: aBlock withAssociationString: associationString [ + | equalsIndex | + equalsIndex := associationString indexOf: $=. + aBlock + value: (associationString first: equalsIndex-1) + value: (associationString allButFirst: equalsIndex) +] + +{ #category : '*System-OSEnvironments' } +OSPlatform >> removeEnvironmentVariableNamed: key [ + "Do nothing" + + +] + +{ #category : '*System-OSEnvironments' } +OSPlatform >> setEnv: nameString value: valueString [ + "We do not support environment Variables. Do Nothing" +] diff --git a/src/System-OSEnvironments/UnixEnvironment.class.st b/src/System-OSEnvironments/UnixEnvironment.class.st deleted file mode 100644 index 413e6416b6f..00000000000 --- a/src/System-OSEnvironments/UnixEnvironment.class.st +++ /dev/null @@ -1,293 +0,0 @@ -" -I am a specialized OSEnvironment version for *nix systems (Linux, OSX). -See my superclass to understand my common usage. - -# Encoding Management - -I provide a variant of the Dictionary-like API that receives an extra argument specifying an encoding. -Valid encodings are those specified by the Zinc-Character-Encoding-* packages. -The API accepts both encoding objects and symbols which are used to lookup encodings. - -For example, the following usages are valid: - -OSEnvironment current at: 'HOME' encoding: #utf8. -OSEnvironment current at: 'HOME' encoding: #utf8 asZnCharacterEncoder. -OSEnvironment current at: 'HOME' encoding: ZnCharacterEncoder utf8. - -# Implementation Details - -I try to use a primitive to get/set environment variables, and if it fails or it is not available, I use corresponding ffi calls using byteArrays with encoded strings as argument. -" -Class { - #name : 'UnixEnvironment', - #superclass : 'OSEnvironment', - #category : 'System-OSEnvironments-Platforms', - #package : 'System-OSEnvironments', - #tag : 'Platforms' -} - -{ #category : 'testing' } -UnixEnvironment class >> isDefaultFor: aPlatform [ - ^ aPlatform isUnix - or: [ aPlatform isMacOSX - or: [ aPlatform isMacOS ] ] -] - -{ #category : 'accessing' } -UnixEnvironment >> at: aKey encoding: anEncoding [ - "Gets the value of an environment variable called `aKey`. - Throws a KeyNotFound exception if not found. - Use `anEncoding` to encode the arguments and return values. - - This is a *nix specific API. - Rationale: In *nix systems (compared to windows systems) environment variables are stored as raw bytes and can be encoded in different forms." - - ^ self at: aKey encoding: anEncoding ifAbsent: [ KeyNotFound signalFor: aKey ] -] - -{ #category : 'accessing' } -UnixEnvironment >> at: aKey encoding: anEncoding ifAbsent: aBlock [ - "Gets the value of an environment variable called `aKey`. - Execute aBlock if absent. - Use `anEncoding` to encode the arguments and return values. - - This is a *nix specific API. - Rationale: In *nix systems (compared to windows systems) environment variables are stored as raw bytes and can be encoded in different forms." - - | result | - result := self - rawAt: (aKey encodeWith: anEncoding) - ifAbsent: [ ^ aBlock value]. - ^ result decodeWith: anEncoding -] - -{ #category : 'accessing' } -UnixEnvironment >> at: aKey encoding: anEncoding ifAbsentPut: aBlock [ - "Gets the value of an environment variable called `aKey`. - If absent, insert the value given by aBlock. - Use `anEncoding` to encode the arguments and return values. - - This is a *nix specific API. - Rationale: In *nix systems (compared to windows systems) environment variables are stored as raw bytes and can be encoded in different forms." - - ^ self at: aKey encoding: anEncoding ifAbsent: [ self at: aKey put: aBlock value encoding: anEncoding ] -] - -{ #category : 'accessing' } -UnixEnvironment >> at: aKey encoding: anEncoding ifPresent: aBlock [ - "Gets the value of an environment variable called `aKey` and invoke aBlock with it. - Return nil if absent. - Use `anEncoding` to encode the arguments and return values. - - This is a *nix specific API. - Rationale: In *nix systems (compared to windows systems) environment variables are stored as raw bytes and can be encoded in different forms." - - ^ aBlock value: (self at: aKey encoding: anEncoding ifAbsent: [ ^ nil ]) -] - -{ #category : 'accessing' } -UnixEnvironment >> at: aKey encoding: anEncoding ifPresent: presentBlock ifAbsent: absentBlock [ - "Gets the value of an environment variable called `aKey`. - Call presentBlock with it if present. - Execute absentBlock if absent. - Use `anEncoding` to encode the arguments and return values. - - This is a *nix specific API. - Rationale: In *nix systems (compared to windows systems) environment variables are stored as raw bytes and can be encoded in different forms." - - self at: aKey encoding: anEncoding ifPresent: [ :v | ^ presentBlock cull: v ]. - ^absentBlock value -] - -{ #category : 'accessing' } -UnixEnvironment >> at: aKey ifAbsent: aBlock [ - "See super>>at:ifAbsent:. - Uses a single encoding determined dynamically" - - ^ self at: aKey encoding: self defaultEncoding ifAbsent: aBlock -] - -{ #category : 'accessing' } -UnixEnvironment >> at: aKey put: aValue [ - "See super>>at:put:. - Uses a single encoding determined dynamically" - - ^ self at: aKey put: aValue encoding: self defaultEncoding -] - -{ #category : 'accessing' } -UnixEnvironment >> at: aKey put: aValue encoding: anEncoding [ - "Sets the value of an environment variable called `aKey` to `aValue`. - Use `anEncoding` to encode both arguments. - - This is a *nix specific API. - Rationale: In *nix systems (compared to windows systems) environment variables are stored as raw bytes and can be encoded in different forms." - - ^ self - rawAt: (aKey encodeWith: anEncoding) - put: (aValue encodeWith: anEncoding) -] - -{ #category : 'private' } -UnixEnvironment >> basicGetEnvRaw: encodedVariableName [ - - "PRIVATE: This primitive call works on Strings, while the correct way to manage encodings is with raw data. - Use me through #rawAt: to correctly marshall data." - - "Gets the value of an environment variable called `anEncodedVariableName` already encoded but in ByteString form." - - - ec ifNil: [ ^ (self basicGetEnvRawViaFFI: encodedVariableName asString) asByteArray]. - self primitiveFail -] - -{ #category : 'private' } -UnixEnvironment >> basicGetEnvRawViaFFI: arg1 [ - - "PRIVATE: This FFI call works on Strings, while the correct way to manage encodings is with raw data. - Use me through #basicGetEnvRaw: to correctly marshall data." - - "This method calls the Standard C Library getenv() function. - The name of the argument (arg1) should fit decompiled version." - - ^ self ffiCall: #( String getenv (String arg1) ) module: LibC -] - -{ #category : 'accessing' } -UnixEnvironment >> defaultEncoding [ - - ^ OSPlatform current defaultEncoding -] - -{ #category : 'private' } -UnixEnvironment >> environ [ - "Return the address of the array holding the environment variables" - ^ FFIExternalArray - fromPointer: (ExternalAddress loadSymbol: 'environ' from: LibC) - type: String -] - -{ #category : 'private' } -UnixEnvironment >> environAt: index [ - ^ self environ at: index -] - -{ #category : 'enumeration' } -UnixEnvironment >> keysAndValuesDo: aBlock [ - | index associationString | - index := 1 . - [ - associationString := self environAt: index. - associationString ifNil: [ ^ self ]. - self keysAndValuesDo: aBlock withAssociationString: associationString. - index := index + 1 - ] repeat -] - -{ #category : 'accessing' } -UnixEnvironment >> rawAt: anEncodedKey [ - "Gets the value of an environment variable called `anEncodedKey` that is already encoded (i.e., it is a byte array). - Throws a KeyNotFound exception if not found. - - This is a *nix specific API. - Rationale: In *nix systems (compared to windows systems) environment variables are stored as raw bytes and can be encoded in different forms." - - ^ self rawAt: anEncodedKey ifAbsent: [ KeyNotFound signalFor: anEncodedKey ] -] - -{ #category : 'accessing' } -UnixEnvironment >> rawAt: anEncodedKey ifAbsent: aBlock [ - "Gets the value of an environment variable called `anEncodedKey` that is already encoded (i.e., it is a byte array). - Execute aBlock if absent. - - This is a *nix specific API. - Rationale: In *nix systems (compared to windows systems) environment variables are stored as raw bytes and can be encoded in different forms." - - | rawValue | - rawValue := self basicGetEnvRaw: anEncodedKey asString. - ^ rawValue - ifNil: [ aBlock value ] - ifNotNil: [ rawValue asByteArray ] -] - -{ #category : 'accessing' } -UnixEnvironment >> rawAt: anEncodedKey ifAbsentPut: aBlock [ - "Gets the value of an environment variable called `aKey` that is already encoded (i.e., it is a byte array). - If absent, insert the value given by aBlock. - - This is a *nix specific API. - Rationale: In *nix systems (compared to windows systems) environment variables are stored as raw bytes and can be encoded in different forms." - - ^ self rawAt: anEncodedKey ifAbsent: [ self rawAt: anEncodedKey put: aBlock value ] -] - -{ #category : 'accessing' } -UnixEnvironment >> rawAt: anEncodedKey ifPresent: aBlock [ - "Gets the value of an environment variable called `anEncodedKey` that is already encoded (i.e., it is a byte array) and invoke aBlock with it. - Return nil if absent. - - This is a *nix specific API. - Rationale: In *nix systems (compared to windows systems) environment variables are stored as raw bytes and can be encoded in different forms." - - ^ aBlock value: (self rawAt: anEncodedKey ifAbsent: [ ^ nil ]) -] - -{ #category : 'accessing' } -UnixEnvironment >> rawAt: anEncodedKey ifPresent: presentBlock ifAbsent: absentBlock [ - "Gets the value of an environment variable called `anEncodedKey` that is already encoded (i.e., it is a byte array). - Call presentBlock with it if present. - Execute absentBlock if absent. - - This is a *nix specific API. - Rationale: In *nix systems (compared to windows systems) environment variables are stored as raw bytes and can be encoded in different forms." - - self rawAt: anEncodedKey ifPresent: [ :v | ^ presentBlock cull: v ]. - ^absentBlock value -] - -{ #category : 'accessing' } -UnixEnvironment >> rawAt: anEncodedKey put: someBytes [ - "Sets the value of an environment variable called `anEncodedKey` to `someBytes`. - Both arguments should be already encoded (i.e., they are byte arrays). - - This is a *nix specific API. - Rationale: In *nix systems (compared to windows systems) environment variables are stored as raw bytes and can be encoded in different forms." - - ^ self setEnv: anEncodedKey asString value: someBytes asString -] - -{ #category : 'accessing' } -UnixEnvironment >> rawRemoveKey: anEncodedKey [ - "Removes an environment variable called `anEncodedKey` that is already encoded (i.e., it is a byte array). - - This is a *nix specific API. - Rationale: In *nix systems (compared to windows systems) environment variables are stored as raw bytes and can be encoded in different forms." - - ^ self unsetEnv: anEncodedKey asString -] - -{ #category : 'accessing' } -UnixEnvironment >> removeKey: key [ - "See super>>removeKey:. - Uses a single encoding determined dynamically" - - ^ self removeKey: key encoded: self defaultEncoding -] - -{ #category : 'accessing' } -UnixEnvironment >> removeKey: key encoded: anEncoding [ - "Removes the entry `aKey` from the environment variables. - Use `anEncoding` to encode the arguments. - - This is a *nix specific API. - Rationale: In *nix systems (compared to windows systems) environment variables are stored as raw bytes and can be encoded in different forms." - - ^ self rawRemoveKey: (key encodeWith: anEncoding) -] - -{ #category : 'accessing' } -UnixEnvironment >> setEnv: nameString value: valueString [ - "int setenv(const char *name, const char *value, int overwrite);" - - ^ self ffiCall: #(int setenv #(String nameString , String valueString , int 1)) module: LibC -] diff --git a/src/System-OSEnvironments/Win32Environment.class.st b/src/System-OSEnvironments/WinPlatform.extension.st similarity index 53% rename from src/System-OSEnvironments/Win32Environment.class.st rename to src/System-OSEnvironments/WinPlatform.extension.st index fc1b5812995..337e38bb4f1 100644 --- a/src/System-OSEnvironments/Win32Environment.class.st +++ b/src/System-OSEnvironments/WinPlatform.extension.st @@ -1,57 +1,9 @@ -" -I am a specialized OSEnvironment for Windows. -See my superclass to understand my common usage. - -# Encoding Management - -Windows hides the environment variables encoding through its API, and it's not up to the user how to encode them. -Thus, I do not propose an API to specify encodings. - -# Implementation Details - -I use FFI calls to manage encodings. Pharo strings are first encoded in utf8 and used to create Win32 WideStrings, whose are used in the windows function calls. -See Win32WideString -" -Class { - #name : 'Win32Environment', - #superclass : 'OSEnvironment', - #category : 'System-OSEnvironments-Platforms', - #package : 'System-OSEnvironments', - #tag : 'Platforms' -} - -{ #category : 'testing' } -Win32Environment class >> isDefaultFor: aPlatform [ - ^ aPlatform isWindows -] - -{ #category : 'accessing' } -Win32Environment >> at: aKey ifAbsent: aBlock [ - "The primitive on Windows currently uses the ascii version of the Windows API. - In such chase try to get value of the environment variable using FFI." - - ^ self getEnvVariable: aKey bufferSize: 500 ifAbsent: aBlock -] +Extension { #name : 'WinPlatform' } -{ #category : 'accessing' } -Win32Environment >> at: aKey put: aValue [ - "The primitive on Windows currently uses the ascii version of the Windows API. - In such chase try to set the value of the environment variable using FFI." +{ #category : '*System-OSEnvironments' } +WinPlatform >> doGetEnvVariable: aVariableName bufferSize: aSize ifAbsent: aBlock isRetry: isRetry [ - | w32Key w32Value return | - w32Key := aKey asWin32WideString. - w32Value := aValue asWin32WideString. - return := self setEnvironmentVariable: w32Key value: w32Value. - - "From MSDN: If the function fails, the return value is zero." - return = 0 ifTrue: [ - self error: 'An error occurred while setting environment variable ', aKey asString, ' to ', aValue asString ] -] - -{ #category : 'private' } -Win32Environment >> doGetEnvVariable: aVariableName bufferSize: aSize ifAbsent: aBlock isRetry: isRetry [ | name buffer return lastErrCode | - name := aVariableName asWin32WideString. buffer := Win32WideString new: aSize. @@ -61,71 +13,94 @@ Win32Environment >> doGetEnvVariable: aVariableName bufferSize: aSize ifAbsent: To do so, we are clearing the last error variable, and also we are retrying. The retrying is needed because we can have a race condition between different API calls." - lastErrCode := OSPlatform current setLastError: 0. - return := OSPlatform current getEnvironmentVariable: name into: buffer size: aSize + 1. - lastErrCode := OSPlatform current lastError. + lastErrCode := self setLastError: 0. + return := self getEnvironmentVariable: name into: buffer size: aSize + 1. + lastErrCode := self lastError. "From MSDN: If the function fails, the return value is zero. If the specified environment variable was not found in the environment block, GetLastError returns ERROR_ENVVAR_NOT_FOUND." return = 0 ifTrue: [ lastErrCode = 0 ifTrue: [ ^ String new ]. - lastErrCode = "ERROR_ENVVAR_NOT_FOUND" 16r000000CB ifTrue: [ ^ aBlock value ]. + lastErrCode = 16r000000CB ifTrue: [ ^ aBlock value ]. "ERROR_ENVVAR_NOT_FOUND" isRetry - ifTrue: [ - self error: 'Error ', lastErrCode printString, - ' occurred while fetching environment variable ', aVariableName asString ] - ifFalse: [ ^ self doGetEnvVariable: aVariableName bufferSize: aSize ifAbsent: aBlock isRetry: true ] ]. + ifTrue: [ self error: 'Error ' , lastErrCode printString , ' occurred while fetching environment variable ' , aVariableName asString ] + ifFalse: [ + ^ self + doGetEnvVariable: aVariableName + bufferSize: aSize + ifAbsent: aBlock + isRetry: true ] ]. "From MSDN: If lpBuffer is not large enough to hold the data, the return value is the buffer size, in characters, required to hold the string and its terminating null character and the contents of lpBuffer are undefined." - return > aSize ifTrue: [ ^ self doGetEnvVariable: aVariableName bufferSize: return ifAbsent: aBlock isRetry: false ]. + return > aSize ifTrue: [ + ^ self + doGetEnvVariable: aVariableName + bufferSize: return + ifAbsent: aBlock + isRetry: false ]. ^ buffer asString ] -{ #category : 'private' } -Win32Environment >> environmentStrings [ +{ #category : '*System-OSEnvironments' } +WinPlatform >> environmentStrings [ ^ self ffiCall: #( void * GetEnvironmentStringsW () ) ] -{ #category : 'private' } -Win32Environment >> ffiLibraryName [ +{ #category : '*System-OSEnvironments' } +WinPlatform >> environmentVariableNamed: aKey ifAbsent: aBlock [ + "The primitive on Windows currently uses the ascii version of the Windows API. + In such chase try to get value of the environment variable using FFI." - ^ #Kernel32 + ^ self getEnvVariable: aKey bufferSize: 500 ifAbsent: aBlock ] -{ #category : 'private' } -Win32Environment >> getEnvVariable: aVariableName bufferSize: aSize ifAbsent: aBlock [ +{ #category : '*System-OSEnvironments' } +WinPlatform >> environmentVariableNamed: aKey put: aValue [ + "The primitive on Windows currently uses the ascii version of the Windows API. + In such chase try to set the value of the environment variable using FFI." - ^ self doGetEnvVariable: aVariableName bufferSize: aSize ifAbsent: aBlock isRetry: false + | w32Key w32Value return | + w32Key := aKey asWin32WideString. + w32Value := aValue asWin32WideString. + return := self setEnvironmentVariable: w32Key value: w32Value. + + "From MSDN: If the function fails, the return value is zero." + return = 0 ifTrue: [ self error: 'An error occurred while setting environment variable ' , aKey asString , ' to ' , aValue asString ] ] -{ #category : 'enumeration' } -Win32Environment >> keysAndValuesDo: aBlock [ +{ #category : '*System-OSEnvironments' } +WinPlatform >> environmentVariablesDo: aBlock [ "Under windows the environemtn variables are a single big String." "Lines starting with an equal sign are invalid per http://stackoverflow.com/questions/10431689/what-are-these-strange-environment-variables" - | environmentStrings nextString win32WideString | + | environmentStrings nextString win32WideString | environmentStrings := self environmentStrings. [ win32WideString := Win32WideString fromHandle: environmentStrings. nextString := win32WideString asString. nextString ifEmpty: [ ^ self ]. - nextString first = $= - ifFalse: [ self keysAndValuesDo: aBlock withAssociationString: nextString ]. + nextString first = $= ifFalse: [ self keysAndValuesDo: aBlock withAssociationString: nextString ]. environmentStrings := environmentStrings + win32WideString byteSize ] repeat ] -{ #category : 'private' } -Win32Environment >> removeEnvironmentVariable: nameString [ +{ #category : '*System-OSEnvironments' } +WinPlatform >> getEnvVariable: aVariableName bufferSize: aSize ifAbsent: aBlock [ + + ^ self doGetEnvVariable: aVariableName bufferSize: aSize ifAbsent: aBlock isRetry: false +] + +{ #category : '*System-OSEnvironments' } +WinPlatform >> removeEnvironmentVariable: nameString [ ^ self ffiCall: #( int SetEnvironmentVariableW ( Win32WideString nameString, Win32WideString 0 ) ) ] -{ #category : 'accessing' } -Win32Environment >> removeKey: aKey [ +{ #category : '*System-OSEnvironments' } +WinPlatform >> removeKey: aKey [ "The primitive on Windows currently uses the ascii version of the Windows API. In such chase try to get value of the environment variable using FFI." @@ -137,17 +112,15 @@ Win32Environment >> removeKey: aKey [ self error: 'An error occurred while removing environment variable ', aKey asString ] ] -{ #category : 'private' } -Win32Environment >> setEnv: nameString value: valueString [ +{ #category : '*System-OSEnvironments' } +WinPlatform >> setEnv: nameString value: valueString [ "This method calls the the platform specific set environment routine" - ^ self - ffiCall: #(int SetEnvironmentVariableA #(String nameString , String valueString)) - module: #Kernel32 + ^ self ffiCall: #( int SetEnvironmentVariableA #( String nameString #, String valueString ) ) module: #Kernel32 ] -{ #category : 'private' } -Win32Environment >> setEnvironmentVariable: nameString value: valueString [ +{ #category : '*System-OSEnvironments' } +WinPlatform >> setEnvironmentVariable: nameString value: valueString [ ^ self ffiCall: #( int SetEnvironmentVariableW ( Win32WideString nameString, Win32WideString valueString ) ) ] diff --git a/src/System-Platforms/AbstractUnixPlatform.class.st b/src/System-Platforms/AbstractUnixPlatform.class.st new file mode 100644 index 00000000000..18db89e36f4 --- /dev/null +++ b/src/System-Platforms/AbstractUnixPlatform.class.st @@ -0,0 +1,16 @@ +" +I am a platform to manage common features between linux and macOS since macOS is also unix. +" +Class { + #name : 'AbstractUnixPlatform', + #superclass : 'OSPlatform', + #category : 'System-Platforms-Unix', + #package : 'System-Platforms', + #tag : 'Unix' +} + +{ #category : 'testing' } +AbstractUnixPlatform class >> isAbstract [ + + ^ self = AbstractUnixPlatform +] diff --git a/src/System-Platforms/MacOSPlatform.class.st b/src/System-Platforms/MacOSPlatform.class.st index 6160ccd5e90..5fbba464eea 100644 --- a/src/System-Platforms/MacOSPlatform.class.st +++ b/src/System-Platforms/MacOSPlatform.class.st @@ -4,7 +4,7 @@ I am a an object representing a Mac OS (pre OSX) platform. Use myself to access " Class { #name : 'MacOSPlatform', - #superclass : 'OSPlatform', + #superclass : 'AbstractUnixPlatform', #category : 'System-Platforms-Mac', #package : 'System-Platforms', #tag : 'Mac' diff --git a/src/System-Platforms/UnixPlatform.class.st b/src/System-Platforms/UnixPlatform.class.st index 4aaceec9113..f2f17f0c072 100644 --- a/src/System-Platforms/UnixPlatform.class.st +++ b/src/System-Platforms/UnixPlatform.class.st @@ -9,7 +9,7 @@ OSPlatform current. " Class { #name : 'UnixPlatform', - #superclass : 'OSPlatform', + #superclass : 'AbstractUnixPlatform', #category : 'System-Platforms-Unix', #package : 'System-Platforms', #tag : 'Unix' diff --git a/src/System-Platforms/WinPlatform.class.st b/src/System-Platforms/WinPlatform.class.st index 924c267a6cf..865aaa87c9e 100644 --- a/src/System-Platforms/WinPlatform.class.st +++ b/src/System-Platforms/WinPlatform.class.st @@ -123,12 +123,6 @@ WinPlatform >> multiByteToWideCharacterCodepage: codepage flags: flags input: in ^self ffiCall: #(int MultiByteToWideChar(uint codepage, ulong flags, void* input, int inputLen, Win32WideString output, int outputLen )) ] -{ #category : 'environment-variables' } -WinPlatform >> setEnvironmentVariable: nameString value: valueString [ - - ^ self ffiCall: #( int SetEnvironmentVariableW ( Win32WideString nameString, Win32WideString valueString ) ) -] - { #category : 'accessing' } WinPlatform >> setLastError: aValue [