From e5722d5176ff4ca3cc8f5f14c22614c1fec1abc8 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Thu, 2 Sep 2021 15:57:33 +0200 Subject: [PATCH 01/16] Removing SecurityPlugin dependencies. --- smalltalksrc/VMMaker/SocketPlugin.class.st | 93 +++------------------- 1 file changed, 9 insertions(+), 84 deletions(-) diff --git a/smalltalksrc/VMMaker/SocketPlugin.class.st b/smalltalksrc/VMMaker/SocketPlugin.class.st index aaa2a4faf1..cef31ce346 100644 --- a/smalltalksrc/VMMaker/SocketPlugin.class.st +++ b/smalltalksrc/VMMaker/SocketPlugin.class.st @@ -4,13 +4,6 @@ Implement the socket and resolver primitives. Since it requires platform suppor Class { #name : #SocketPlugin, #superclass : #SmartSyntaxInterpreterPlugin, - #instVars : [ - 'sDSAfn', - 'sHSAfn', - 'sCCTPfn', - 'sCCLOPfn', - 'sCCSOTfn' - ], #category : #'VMMaker-Plugins' } @@ -43,12 +36,9 @@ SocketPlugin class >> requiresPlatformFiles [ { #category : #'initialize-release' } SocketPlugin >> initialiseModule [ + - sDSAfn := interpreterProxy ioLoadFunction: 'secDisableSocketAccess' From: 'SecurityPlugin'. - sHSAfn := interpreterProxy ioLoadFunction: 'secHasSocketAccess' From: 'SecurityPlugin'. - sCCTPfn := interpreterProxy ioLoadFunction: 'secCanConnectToPort' From: 'SecurityPlugin'. - sCCLOPfn := interpreterProxy ioLoadFunction: 'secCanListenOnPort' From: 'SecurityPlugin'. - sCCSOTfn := interpreterProxy ioLoadFunction: 'secCanCreateSocketOfType' From: 'SecurityPlugin'. + ^self socketInit ] @@ -70,18 +60,6 @@ SocketPlugin >> intToNetAddress: addr [ ^ netAddressOop ] -{ #category : #'initialize-release' } -SocketPlugin >> moduleUnloaded: aModuleName [ - "The module with the given name was just unloaded. - Make sure we have no dangling references." - - - (aModuleName strcmp: 'SecurityPlugin') = 0 ifTrue:[ - "The security plugin just shut down. How odd." - sDSAfn := sHSAfn := sCCTPfn := sCCLOPfn := sCCSOTfn := 0. - ]. -] - { #category : #primitives } SocketPlugin >> netAddressToInt: ptrToByteArray [ "Convert the given internet network address (represented as a four-byte ByteArray) into a 32-bit integer. Fail if the given ptrToByteArray does not appear to point to a four-byte ByteArray." @@ -96,24 +74,6 @@ SocketPlugin >> netAddressToInt: ptrToByteArray [ ((ptrToByteArray at: 0) <<24) ] -{ #category : #'security primitives' } -SocketPlugin >> primitiveDisableSocketAccess [ - - "If the security plugin can be loaded, use it to turn off socket access - If not, assume it's ok" - sDSAfn ~= 0 ifTrue: - [self cCode: '((sqInt (*) (void)) sDSAfn)()'] -] - -{ #category : #'security primitives' } -SocketPlugin >> primitiveHasSocketAccess [ - self primitive: 'primitiveHasSocketAccess'. - "If the security plugin can be loaded, use it to check . - If not, assume it's ok" - ^(sHSAfn = 0 - or: [self cCode: ' ((sqInt (*) (void)) sHSAfn)()' inSmalltalk: [true]]) asBooleanObj -] - { #category : #primitives } SocketPlugin >> primitiveInitializeNetwork: resolverSemaIndex [ @@ -416,12 +376,7 @@ SocketPlugin >> primitiveSocket: socket connectTo: address port: port [ self primitive: 'primitiveSocketConnectToPort' parameters: #(#Oop #ByteArray #SmallInteger ). addr := self netAddressToInt: (self cCoerce: address to: 'unsigned char *'). - "If the security plugin can be loaded, use it to check for permission. - If not, assume it's ok" - sCCTPfn ~= 0 ifTrue: - [okToConnect := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCTPfn)(addr, port)'. - okToConnect ifFalse: - [^ interpreterProxy primitiveFail]]. + s := self socketValueOf: socket. interpreterProxy failed ifFalse: [self sqSocket: s ConnectTo: addr Port: port] @@ -464,12 +419,7 @@ SocketPlugin >> primitiveSocket: socket listenOnPort: port [ self primitive: 'primitiveSocketListenOnPort' parameters: #(#Oop #SmallInteger ). s := self socketValueOf: socket. - "If the security plugin can be loaded, use it to check for permission. - If not, assume it's ok" - sCCLOPfn ~= 0 ifTrue: - [okToListen := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCLOPfn)((sqInt)s, port)'. - okToListen ifFalse: - [^ interpreterProxy primitiveFail]]. + interpreterProxy failed ifFalse: [self sqSocket: s ListenOnPort: port] ] @@ -483,12 +433,7 @@ SocketPlugin >> primitiveSocket: socket listenOnPort: port backlogSize: backlog self primitive: 'primitiveSocketListenOnPortBacklog' parameters: #(#Oop #SmallInteger #SmallInteger ). s := self socketValueOf: socket. - "If the security plugin can be loaded, use it to check for permission. - If not, assume it's ok" - sCCLOPfn ~= 0 ifTrue: - [okToListen := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCLOPfn)((sqInt)s, port)'. - okToListen ifFalse: - [^interpreterProxy primitiveFail]]. + self sqSocket: s ListenOnPort: port BacklogSize: backlog ] @@ -500,12 +445,7 @@ SocketPlugin >> primitiveSocket: socket listenOnPort: port backlogSize: backlog self primitive: 'primitiveSocketListenOnPortBacklogInterface' parameters: #(#Oop #SmallInteger #SmallInteger #ByteArray). s := self socketValueOf: socket. - "If the security plugin can be loaded, use it to check for permission. - If not, assume it's ok" - sCCLOPfn ~= 0 ifTrue: - [okToListen := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCLOPfn)((sqInt)s, port)'. - okToListen ifFalse: - [^ interpreterProxy primitiveFail]]. + addr := self netAddressToInt: (self cCoerce: ifAddr to: 'unsigned char *'). self sqSocket: s ListenOnPort: port BacklogSize: backlog Interface: addr ] @@ -826,12 +766,7 @@ SocketPlugin >> primitiveSocketCreateNetwork: netType type: socketType receiveBu | socketOop s okToCreate | self primitive: 'primitiveSocketCreate' parameters: #(#SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger ). - "If the security plugin can be loaded, use it to check for permission. - If not, assume it's ok" - sCCSOTfn ~= 0 ifTrue: - [okToCreate := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCSOTfn)(netType, socketType)'. - okToCreate ifFalse: - [^ interpreterProxy primitiveFail]]. + socketOop := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self socketRecordSize. s := self socketValueOf: socketOop. interpreterProxy failed ifFalse: @@ -850,12 +785,7 @@ SocketPlugin >> primitiveSocketCreateNetwork: netType type: socketType receiveBu | socketOop s okToCreate | self primitive: 'primitiveSocketCreate3Semaphores' parameters: #(#SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger ). - "If the security plugin can be loaded, use it to check for permission. - If not, assume it's ok" - sCCSOTfn ~= 0 ifTrue: - [okToCreate := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCSOTfn)(netType, socketType)'. - okToCreate ifFalse: - [^ interpreterProxy primitiveFail]]. + socketOop := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self socketRecordSize. s := self socketValueOf: socketOop. interpreterProxy failed ifFalse: @@ -876,12 +806,7 @@ SocketPlugin >> primitiveSocketCreateRaw: netType type: protoType receiveBufferS | socketOop s okToCreate | self primitive: 'primitiveSocketCreateRAW' parameters: #(#SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger ). - "If the security plugin can be loaded, use it to check for permission. - If not, assume it's ok" - sCCSOTfn ~= 0 ifTrue: - [okToCreate := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCSOTfn)(netType, protoType)'. - okToCreate ifFalse: - [^ interpreterProxy primitiveFail]]. + socketOop := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self socketRecordSize. s := self socketValueOf: socketOop. interpreterProxy failed ifFalse: From e2b6d3f56b4836d09f2164f1e3216f91883dfb3d Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Thu, 2 Sep 2021 17:47:31 +0200 Subject: [PATCH 02/16] Generating the SocketPlugin from code --- .../SocketPlugin/src/common/SocketPlugin.c | 2440 ----------------- plugins.cmake | 21 +- .../SocketPlugin/include}/SocketPlugin.h | 0 .../SocketPlugin/src}/SocketPluginImpl.c | 0 4 files changed, 17 insertions(+), 2444 deletions(-) delete mode 100644 extracted/plugins/SocketPlugin/src/common/SocketPlugin.c rename {extracted/plugins/SocketPlugin/include/common => plugins/SocketPlugin/include}/SocketPlugin.h (100%) rename {extracted/plugins/SocketPlugin/src/common => plugins/SocketPlugin/src}/SocketPluginImpl.c (100%) diff --git a/extracted/plugins/SocketPlugin/src/common/SocketPlugin.c b/extracted/plugins/SocketPlugin/src/common/SocketPlugin.c deleted file mode 100644 index 989facd250..0000000000 --- a/extracted/plugins/SocketPlugin/src/common/SocketPlugin.c +++ /dev/null @@ -1,2440 +0,0 @@ -/* Automatically generated by - SmartSyntaxPluginCodeGenerator VMMaker.oscog-eem.2495 uuid: fcbf4c90-4c50-4ff3-8690-0edfded4f9c4 - from - SocketPlugin VMMaker.oscog-eem.2495 uuid: fcbf4c90-4c50-4ff3-8690-0edfded4f9c4 - */ -static char __buildInfo[] = "SocketPlugin VMMaker.oscog-eem.2495 uuid: fcbf4c90-4c50-4ff3-8690-0edfded4f9c4 " __DATE__ ; - - - -#include "config.h" -#include -#include -#include -#include -#include - -/* Default EXPORT macro that does nothing (see comment in sq.h): */ -#define EXPORT(returnType) returnType - -/* Do not include the entire sq.h file but just those parts needed. */ -#include "sqConfig.h" /* Configuration options */ -#include "sqVirtualMachine.h" /* The virtual machine proxy definition */ -#include "sqPlatformSpecific.h" /* Platform specific definitions */ - -#define true 1 -#define false 0 -#define null 0 /* using 'null' because nil is predefined in Think C */ -#ifdef SQUEAK_BUILTIN_PLUGIN -# undef EXPORT -# define EXPORT(returnType) static returnType -#endif - -#include "SocketPlugin.h" -#include "sqMemoryAccess.h" - - -/*** Constants ***/ -#define PrimErrBadArgument 3 - - -/*** Function Prototypes ***/ -EXPORT(const char*) getModuleName(void); -EXPORT(sqInt) initialiseModule(void); -static sqInt intToNetAddress(sqInt addr); -EXPORT(sqInt) moduleUnloaded(char *aModuleName); -static sqInt netAddressToInt(unsigned char *ptrToByteArray); -EXPORT(sqInt) primitiveInitializeNetwork(void); -EXPORT(sqInt) primitiveResolverAbortLookup(void); -EXPORT(sqInt) primitiveResolverAddressLookupResult(void); -EXPORT(sqInt) primitiveResolverError(void); -EXPORT(sqInt) primitiveResolverGetAddressInfo(void); -EXPORT(sqInt) primitiveResolverGetAddressInfoFamily(void); -EXPORT(sqInt) primitiveResolverGetAddressInfoNext(void); -EXPORT(sqInt) primitiveResolverGetAddressInfoProtocol(void); -EXPORT(sqInt) primitiveResolverGetAddressInfoResult(void); -EXPORT(sqInt) primitiveResolverGetAddressInfoSize(void); -EXPORT(sqInt) primitiveResolverGetAddressInfoType(void); -EXPORT(sqInt) primitiveResolverGetNameInfo(void); -EXPORT(sqInt) primitiveResolverGetNameInfoHostResult(void); -EXPORT(sqInt) primitiveResolverGetNameInfoHostSize(void); -EXPORT(sqInt) primitiveResolverGetNameInfoServiceResult(void); -EXPORT(sqInt) primitiveResolverGetNameInfoServiceSize(void); -EXPORT(sqInt) primitiveResolverHostNameResult(void); -EXPORT(sqInt) primitiveResolverHostNameSize(void); -EXPORT(sqInt) primitiveResolverLocalAddress(void); -EXPORT(sqInt) primitiveResolverNameLookupResult(void); -EXPORT(sqInt) primitiveResolverStartAddressLookup(void); -EXPORT(sqInt) primitiveResolverStartNameLookup(void); -EXPORT(sqInt) primitiveResolverStatus(void); -EXPORT(sqInt) primitiveSocketAbortConnection(void); -EXPORT(sqInt) primitiveSocketAccept(void); -EXPORT(sqInt) primitiveSocketAccept3Semaphores(void); -EXPORT(sqInt) primitiveSocketAddressGetPort(void); -EXPORT(sqInt) primitiveSocketAddressSetPort(void); -EXPORT(sqInt) primitiveSocketBindTo(void); -EXPORT(sqInt) primitiveSocketBindToPort(void); -EXPORT(sqInt) primitiveSocketCloseConnection(void); -EXPORT(sqInt) primitiveSocketConnectionStatus(void); -EXPORT(sqInt) primitiveSocketConnectTo(void); -EXPORT(sqInt) primitiveSocketConnectToPort(void); -EXPORT(sqInt) primitiveSocketCreate(void); -EXPORT(sqInt) primitiveSocketCreate3Semaphores(void); -EXPORT(sqInt) primitiveSocketCreateRAW(void); -EXPORT(sqInt) primitiveSocketDestroy(void); -EXPORT(sqInt) primitiveSocketError(void); -EXPORT(sqInt) primitiveSocketGetOptions(void); -EXPORT(sqInt) primitiveSocketListenOnPort(void); -EXPORT(sqInt) primitiveSocketListenOnPortBacklog(void); -EXPORT(sqInt) primitiveSocketListenOnPortBacklogInterface(void); -EXPORT(sqInt) primitiveSocketListenWithBacklog(void); -EXPORT(sqInt) primitiveSocketListenWithOrWithoutBacklog(void); -EXPORT(sqInt) primitiveSocketLocalAddress(void); -EXPORT(sqInt) primitiveSocketLocalAddressResult(void); -EXPORT(sqInt) primitiveSocketLocalAddressSize(void); -EXPORT(sqInt) primitiveSocketLocalPort(void); -EXPORT(sqInt) primitiveSocketReceiveDataAvailable(void); -EXPORT(sqInt) primitiveSocketReceiveDataBufCount(void); -EXPORT(sqInt) primitiveSocketReceiveUDPDataBufCount(void); -EXPORT(sqInt) primitiveSocketRemoteAddress(void); -EXPORT(sqInt) primitiveSocketRemoteAddressResult(void); -EXPORT(sqInt) primitiveSocketRemoteAddressSize(void); -EXPORT(sqInt) primitiveSocketRemotePort(void); -EXPORT(sqInt) primitiveSocketSendDataBufCount(void); -EXPORT(sqInt) primitiveSocketSendDone(void); -EXPORT(sqInt) primitiveSocketSendUDPDataBufCount(void); -EXPORT(sqInt) primitiveSocketSetOptions(void); -EXPORT(sqInt) setInterpreter(struct VirtualMachine *anInterpreter); -EXPORT(sqInt) shutdownModule(void); -static sqInt socketRecordSize(void); -static SocketPtr socketValueOf(sqInt socketOop); -static sqInt sqAssert(sqInt aBool); - - -/*** Variables ***/ - -#if !defined(SQUEAK_BUILTIN_PLUGIN) -static sqInt (*byteSizeOf)(sqInt oop); -static sqInt (*classArray)(void); -static sqInt (*classByteArray)(void); -static sqInt (*classString)(void); -static sqInt (*failed)(void); -static sqInt (*falseObject)(void); -static void * (*firstIndexableField)(sqInt oop); -static sqInt (*instantiateClassindexableSize)(sqInt classPointer, sqInt size); -static sqInt (*integerObjectOf)(sqInt value); -static void * (*ioLoadFunctionFrom)(char *functionName, char *moduleName); -static sqInt (*isBytes)(sqInt oop); -static sqInt (*isIntegerObject)(sqInt objectPointer); -static sqInt (*isWords)(sqInt oop); -static sqInt (*isWordsOrBytes)(sqInt oop); -static sqInt (*methodArgumentCount)(void); -static sqInt (*pop)(sqInt nItems); -static sqInt (*popthenPush)(sqInt nItems, sqInt oop); -static sqInt (*popRemappableOop)(void); -static sqInt (*primitiveFail)(void); -static sqInt (*primitiveFailFor)(sqInt reasonCode); -static sqInt (*pushRemappableOop)(sqInt oop); -static sqInt (*slotSizeOf)(sqInt oop); -static sqInt (*stackIntegerValue)(sqInt offset); -static sqInt (*stackValue)(sqInt offset); -static sqInt (*storePointerofObjectwithValue)(sqInt index, sqInt oop, sqInt valuePointer); -static sqInt (*success)(sqInt aBoolean); -static sqInt (*trueObject)(void); -#else /* !defined(SQUEAK_BUILTIN_PLUGIN) */ -extern sqInt byteSizeOf(sqInt oop); -extern sqInt classArray(void); -extern sqInt classByteArray(void); -extern sqInt classString(void); -extern sqInt failed(void); -extern sqInt falseObject(void); -extern void * firstIndexableField(sqInt oop); -extern sqInt instantiateClassindexableSize(sqInt classPointer, sqInt size); -extern sqInt integerObjectOf(sqInt value); -extern void * ioLoadFunctionFrom(char *functionName, char *moduleName); -extern sqInt isBytes(sqInt oop); -#if !defined(isIntegerObject) -extern sqInt isIntegerObject(sqInt objectPointer); -#endif -extern sqInt isWords(sqInt oop); -extern sqInt isWordsOrBytes(sqInt oop); -extern sqInt methodArgumentCount(void); -extern sqInt pop(sqInt nItems); -extern sqInt popthenPush(sqInt nItems, sqInt oop); -extern sqInt popRemappableOop(void); -extern sqInt primitiveFail(void); -extern sqInt primitiveFailFor(sqInt reasonCode); -extern sqInt pushRemappableOop(sqInt oop); -extern sqInt slotSizeOf(sqInt oop); -extern sqInt stackIntegerValue(sqInt offset); -extern sqInt stackValue(sqInt offset); -extern sqInt storePointerofObjectwithValue(sqInt index, sqInt oop, sqInt valuePointer); -extern sqInt success(sqInt aBoolean); -extern sqInt trueObject(void); -extern -#endif -struct VirtualMachine* interpreterProxy; -static const char *moduleName = -#ifdef SQUEAK_BUILTIN_PLUGIN - "SocketPlugin VMMaker.oscog-eem.2495 (i)" -#else - "SocketPlugin VMMaker.oscog-eem.2495 (e)" -#endif -; - - -/* Note: This is hardcoded so it can be run from Squeak. - The module name is used for validating a module *after* - it is loaded to check if it does really contain the module - we're thinking it contains. This is important! */ - - /* InterpreterPlugin>>#getModuleName */ -EXPORT(const char*) -getModuleName(void) -{ - return moduleName; -} - - /* SocketPlugin>>#initialiseModule */ -EXPORT(sqInt) -initialiseModule(void) -{ - return socketInit(); -} - - -/* Convert the given 32-bit integer into an internet network address - represented as a four-byte ByteArray. - */ - - /* SocketPlugin>>#intToNetAddress: */ -static sqInt -intToNetAddress(sqInt addr) -{ - char *naPtr; - sqInt netAddressOop; - - netAddressOop = instantiateClassindexableSize(classByteArray(), 4); - naPtr = ((char *)firstIndexableField(netAddressOop)); - naPtr[0] = (((char) ((((usqInt) addr) >> 24) & 0xFF))); - naPtr[1] = (((char) ((((usqInt) addr) >> 16) & 0xFF))); - naPtr[2] = (((char) ((((usqInt) addr) >> 8) & 0xFF))); - naPtr[3] = (((char) (addr & 0xFF))); - return netAddressOop; -} - - -/* The module with the given name was just unloaded. - Make sure we have no dangling references. */ - - /* SocketPlugin>>#moduleUnloaded: */ -EXPORT(sqInt) -moduleUnloaded(char *aModuleName) -{ - return 0; -} - - -/* Convert the given internet network address (represented as a four-byte - ByteArray) into a 32-bit integer. Fail if the given ptrToByteArray does - not appear to point to a four-byte ByteArray. - */ - - /* SocketPlugin>>#netAddressToInt: */ -static sqInt -netAddressToInt(unsigned char *ptrToByteArray) -{ - sqInt sz; - - sz = byteSizeOf(((sqInt)(sqIntptr_t)(ptrToByteArray) - BaseHeaderSize)); - if (!(sz == 4)) { - return primitiveFail(); - } - return (((ptrToByteArray[3]) + (((usqInt)((ptrToByteArray[2])) << 8))) + (((usqInt)((ptrToByteArray[1])) << 16))) + (((usqInt)((ptrToByteArray[0])) << 24)); -} - - - /* SocketPlugin>>#primitiveInitializeNetwork: */ -EXPORT(sqInt) -primitiveInitializeNetwork(void) -{ - sqInt err; - sqInt resolverSemaIndex; - - if (!(isIntegerObject(stackValue(0)))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - resolverSemaIndex = stackIntegerValue(0); - if (failed()) { - return null; - } - err = sqNetworkInit(resolverSemaIndex); - success(err == 0); - if (!(failed())) { - pop(1); - } - return null; -} - - /* SocketPlugin>>#primitiveResolverAbortLookup */ -EXPORT(sqInt) -primitiveResolverAbortLookup(void) -{ - sqResolverAbort(); - return null; -} - - /* SocketPlugin>>#primitiveResolverAddressLookupResult */ -EXPORT(sqInt) -primitiveResolverAddressLookupResult(void) -{ - sqInt s; - sqInt sz; - - s = 0; - sz = sqResolverAddrLookupResultSize(); - if (!(failed())) { - s = instantiateClassindexableSize(classString(), sz); - sqResolverAddrLookupResult(((char *)firstIndexableField(s)), sz); - } - if (!(failed())) { - popthenPush(1, s); - } - return null; -} - - /* SocketPlugin>>#primitiveResolverError */ -EXPORT(sqInt) -primitiveResolverError(void) -{ - popthenPush(1, integerObjectOf((sqResolverError()))); - return null; -} - - /* SocketPlugin>>#primitiveResolverGetAddressInfoHost:service:flags:family:type:protocol: */ -EXPORT(sqInt) -primitiveResolverGetAddressInfo(void) -{ - sqInt family; - sqInt flags; - char *hostName; - sqInt hostSize; - sqInt protocol; - char *servName; - sqInt servSize; - sqInt type; - - if (!((isBytes(stackValue(5))) - && ((isBytes(stackValue(4))) - && ((isIntegerObject(stackValue(3))) - && ((isIntegerObject(stackValue(2))) - && ((isIntegerObject(stackValue(1))) - && (isIntegerObject(stackValue(0))))))))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - hostName = ((char *) (firstIndexableField(stackValue(5)))); - servName = ((char *) (firstIndexableField(stackValue(4)))); - flags = stackIntegerValue(3); - family = stackIntegerValue(2); - type = stackIntegerValue(1); - protocol = stackIntegerValue(0); - if (failed()) { - return null; - } - if (!(failed())) { - hostSize = byteSizeOf(((sqInt)(sqIntptr_t)(hostName) - BaseHeaderSize)); - servSize = byteSizeOf(((sqInt)(sqIntptr_t)(servName) - BaseHeaderSize)); - sqResolverGetAddressInfoHostSizeServiceSizeFlagsFamilyTypeProtocol(hostName, hostSize, servName, servSize, flags, family, type, protocol); - } - if (!(failed())) { - pop(6); - } - return null; -} - - /* SocketPlugin>>#primitiveResolverGetAddressInfoFamily */ -EXPORT(sqInt) -primitiveResolverGetAddressInfoFamily(void) -{ - sqInt family; - - if (!(failed())) { - family = sqResolverGetAddressInfoFamily(); - if (!(failed())) { - popthenPush(1, integerObjectOf(family)); - } - return null; - } - return null; -} - - /* SocketPlugin>>#primitiveResolverGetAddressInfoNext */ -EXPORT(sqInt) -primitiveResolverGetAddressInfoNext(void) -{ - sqInt more; - - more = sqResolverGetAddressInfoNext(); - if (failed()) { - return null; - } - if (!(failed())) { - popthenPush(1, ((more) ? trueObject() : falseObject())); - } - return null; -} - - /* SocketPlugin>>#primitiveResolverGetAddressInfoProtocol */ -EXPORT(sqInt) -primitiveResolverGetAddressInfoProtocol(void) -{ - sqInt protocol; - - if (!(failed())) { - protocol = sqResolverGetAddressInfoProtocol(); - if (!(failed())) { - popthenPush(1, integerObjectOf(protocol)); - } - return null; - } - return null; -} - - /* SocketPlugin>>#primitiveResolverGetAddressInfoResult: */ -EXPORT(sqInt) -primitiveResolverGetAddressInfoResult(void) -{ - sqInt addrSize; - char *socketAddress; - - if (!(isBytes(stackValue(0)))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - socketAddress = ((char *) (firstIndexableField(stackValue(0)))); - if (failed()) { - return null; - } - if (!(failed())) { - addrSize = byteSizeOf(((sqInt)(sqIntptr_t)(socketAddress) - BaseHeaderSize)); - sqResolverGetAddressInfoResultSize(socketAddress, addrSize); - } - if (!(failed())) { - pop(1); - } - return null; -} - - /* SocketPlugin>>#primitiveResolverGetAddressInfoSize */ -EXPORT(sqInt) -primitiveResolverGetAddressInfoSize(void) -{ - sqInt size; - - if (!(failed())) { - size = sqResolverGetAddressInfoSize(); - if (!(failed())) { - popthenPush(1, integerObjectOf(size)); - } - return null; - } - return null; -} - - /* SocketPlugin>>#primitiveResolverGetAddressInfoType */ -EXPORT(sqInt) -primitiveResolverGetAddressInfoType(void) -{ - sqInt type; - - if (!(failed())) { - type = sqResolverGetAddressInfoType(); - if (!(failed())) { - popthenPush(1, integerObjectOf(type)); - } - return null; - } - return null; -} - - /* SocketPlugin>>#primitiveResolverGetNameInfo:flags: */ -EXPORT(sqInt) -primitiveResolverGetNameInfo(void) -{ - char *addrBase; - sqInt addrSize; - sqInt flags; - sqInt socketAddress; - - if (!(isIntegerObject(stackValue(0)))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - socketAddress = stackValue(1); - flags = stackIntegerValue(0); - if (failed()) { - return null; - } - if (!(failed())) { - addrSize = byteSizeOf(socketAddress); - addrBase = ((char *) (firstIndexableField(socketAddress))); - sqResolverGetNameInfoSizeFlags(addrBase, addrSize, flags); - } - if (!(failed())) { - pop(2); - } - return null; -} - - /* SocketPlugin>>#primitiveResolverGetNameInfoHostResult: */ -EXPORT(sqInt) -primitiveResolverGetNameInfoHostResult(void) -{ - sqInt addrSize; - char *socketName; - - if (!(isBytes(stackValue(0)))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - socketName = ((char *) (firstIndexableField(stackValue(0)))); - if (failed()) { - return null; - } - if (!(failed())) { - addrSize = byteSizeOf(((sqInt)(sqIntptr_t)(socketName) - BaseHeaderSize)); - sqResolverGetNameInfoHostResultSize(socketName, addrSize); - } - if (!(failed())) { - pop(1); - } - return null; -} - - /* SocketPlugin>>#primitiveResolverGetNameInfoHostSize */ -EXPORT(sqInt) -primitiveResolverGetNameInfoHostSize(void) -{ - sqInt size; - - if (!(failed())) { - size = sqResolverGetNameInfoHostSize(); - if (!(failed())) { - popthenPush(1, integerObjectOf(size)); - } - return null; - } - return null; -} - - /* SocketPlugin>>#primitiveResolverGetNameInfoServiceResult: */ -EXPORT(sqInt) -primitiveResolverGetNameInfoServiceResult(void) -{ - sqInt addrSize; - char *socketName; - - if (!(isBytes(stackValue(0)))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - socketName = ((char *) (firstIndexableField(stackValue(0)))); - if (failed()) { - return null; - } - if (!(failed())) { - addrSize = byteSizeOf(((sqInt)(sqIntptr_t)(socketName) - BaseHeaderSize)); - sqResolverGetNameInfoServiceResultSize(socketName, addrSize); - } - if (!(failed())) { - pop(1); - } - return null; -} - - /* SocketPlugin>>#primitiveResolverGetNameInfoServiceSize */ -EXPORT(sqInt) -primitiveResolverGetNameInfoServiceSize(void) -{ - sqInt size; - - if (!(failed())) { - size = sqResolverGetNameInfoServiceSize(); - if (!(failed())) { - popthenPush(1, integerObjectOf(size)); - } - return null; - } - return null; -} - - /* SocketPlugin>>#primitiveResolverHostNameResult: */ -EXPORT(sqInt) -primitiveResolverHostNameResult(void) -{ - sqInt nameSize; - char *nameString; - - if (!(isBytes(stackValue(0)))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - nameString = ((char *) (firstIndexableField(stackValue(0)))); - if (failed()) { - return null; - } - if (!(failed())) { - nameSize = byteSizeOf(((sqInt)(sqIntptr_t)(nameString) - BaseHeaderSize)); - sqResolverHostNameResultSize(nameString, nameSize); - } - if (!(failed())) { - pop(1); - } - return null; -} - - /* SocketPlugin>>#primitiveResolverHostNameSize */ -EXPORT(sqInt) -primitiveResolverHostNameSize(void) -{ - sqInt size; - - if (!(failed())) { - size = sqResolverHostNameSize(); - if (!(failed())) { - popthenPush(1, integerObjectOf(size)); - return null; - } - } - return null; -} - - /* SocketPlugin>>#primitiveResolverLocalAddress */ -EXPORT(sqInt) -primitiveResolverLocalAddress(void) -{ - sqInt addr; - sqInt _return_value; - - addr = sqResolverLocalAddress(); - if (!(failed())) { - _return_value = intToNetAddress(addr); - if (!(failed())) { - popthenPush(1, _return_value); - } - } - return null; -} - - /* SocketPlugin>>#primitiveResolverNameLookupResult */ -EXPORT(sqInt) -primitiveResolverNameLookupResult(void) -{ - sqInt addr; - sqInt _return_value; - - addr = sqResolverNameLookupResult(); - if (!(failed())) { - _return_value = intToNetAddress(addr); - if (!(failed())) { - popthenPush(1, _return_value); - } - } - return null; -} - - /* SocketPlugin>>#primitiveResolverStartAddressLookup: */ -EXPORT(sqInt) -primitiveResolverStartAddressLookup(void) -{ - sqInt addr; - char *address; - sqInt sz; - - if (!(isBytes(stackValue(0)))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - address = ((char *) (firstIndexableField(stackValue(0)))); - if (failed()) { - return null; - } - /* begin netAddressToInt: */ - sz = byteSizeOf(((sqInt)(sqIntptr_t)((((unsigned char *) address))) - BaseHeaderSize)); - if (!(sz == 4)) { - addr = primitiveFail(); - goto l1; - } - addr = ((((((unsigned char *) address))[3]) + (((usqInt)(((((unsigned char *) address))[2])) << 8))) + (((usqInt)(((((unsigned char *) address))[1])) << 16))) + (((usqInt)(((((unsigned char *) address))[0])) << 24)); - l1: /* end netAddressToInt: */; - if (!(failed())) { - sqResolverStartAddrLookup(addr); - } - if (!(failed())) { - pop(1); - } - return null; -} - - /* SocketPlugin>>#primitiveResolverStartNameLookup: */ -EXPORT(sqInt) -primitiveResolverStartNameLookup(void) -{ - char *name; - sqInt sz; - - if (!(isBytes(stackValue(0)))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - name = ((char *) (firstIndexableField(stackValue(0)))); - if (failed()) { - return null; - } - if (!(failed())) { - sz = byteSizeOf(((sqInt)(sqIntptr_t)(name) - BaseHeaderSize)); - sqResolverStartNameLookup(name, sz); - } - if (!(failed())) { - pop(1); - } - return null; -} - - /* SocketPlugin>>#primitiveResolverStatus */ -EXPORT(sqInt) -primitiveResolverStatus(void) -{ - sqInt status; - - status = sqResolverStatus(); - if (!(failed())) { - popthenPush(1, integerObjectOf(status)); - } - return null; -} - - /* SocketPlugin>>#primitiveSocketAbortConnection: */ -EXPORT(sqInt) -primitiveSocketAbortConnection(void) -{ - SocketPtr s; - sqInt socket; - - socket = stackValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - if (!(failed())) { - sqSocketAbortConnection(s); - } - if (!(failed())) { - pop(1); - } - return null; -} - - /* SocketPlugin>>#primitiveSocketAcceptFrom:rcvBufferSize:sndBufSize:semaIndex: */ -EXPORT(sqInt) -primitiveSocketAccept(void) -{ - sqInt recvBufSize; - SocketPtr s; - sqInt semaIndex; - sqInt sendBufSize; - SocketPtr serverSocket; - sqInt socketOop; - sqInt sockHandle; - - socketOop = 0; - if (!((isIntegerObject(stackValue(2))) - && ((isIntegerObject(stackValue(1))) - && (isIntegerObject(stackValue(0)))))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - sockHandle = stackValue(3); - recvBufSize = stackIntegerValue(2); - sendBufSize = stackIntegerValue(1); - semaIndex = stackIntegerValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(sockHandle)) - && ((byteSizeOf(sockHandle)) == (sizeof(SQSocket)))) { - serverSocket = ((SocketPtr) (firstIndexableField(sockHandle))); - } - else { - primitiveFailFor(PrimErrBadArgument); - serverSocket = null; - } - if (!(failed())) { - socketOop = instantiateClassindexableSize(classByteArray(), sizeof(SQSocket)); - /* begin socketValueOf: */ - if ((isBytes(socketOop)) - && ((byteSizeOf(socketOop)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socketOop))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - sqSocketAcceptFromRecvBytesSendBytesSemaID(s, serverSocket, recvBufSize, sendBufSize, semaIndex); - } - if (!(failed())) { - popthenPush(5, socketOop); - } - return null; -} - - /* SocketPlugin>>#primitiveSocketAcceptFrom:rcvBufferSize:sndBufSize:semaIndex:readSemaIndex:writeSemaIndex: */ -EXPORT(sqInt) -primitiveSocketAccept3Semaphores(void) -{ - sqInt aReadSema; - sqInt aWriteSema; - sqInt recvBufSize; - SocketPtr s; - sqInt semaIndex; - sqInt sendBufSize; - SocketPtr serverSocket; - sqInt socketOop; - sqInt sockHandle; - - socketOop = 0; - if (!((isIntegerObject(stackValue(4))) - && ((isIntegerObject(stackValue(3))) - && ((isIntegerObject(stackValue(2))) - && ((isIntegerObject(stackValue(1))) - && (isIntegerObject(stackValue(0)))))))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - sockHandle = stackValue(5); - recvBufSize = stackIntegerValue(4); - sendBufSize = stackIntegerValue(3); - semaIndex = stackIntegerValue(2); - aReadSema = stackIntegerValue(1); - aWriteSema = stackIntegerValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(sockHandle)) - && ((byteSizeOf(sockHandle)) == (sizeof(SQSocket)))) { - serverSocket = ((SocketPtr) (firstIndexableField(sockHandle))); - } - else { - primitiveFailFor(PrimErrBadArgument); - serverSocket = null; - } - if (!(failed())) { - socketOop = instantiateClassindexableSize(classByteArray(), sizeof(SQSocket)); - /* begin socketValueOf: */ - if ((isBytes(socketOop)) - && ((byteSizeOf(socketOop)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socketOop))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - sqSocketAcceptFromRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(s, serverSocket, recvBufSize, sendBufSize, semaIndex, aReadSema, aWriteSema); - } - if (!(failed())) { - popthenPush(7, socketOop); - } - return null; -} - - /* SocketPlugin>>#primitiveSocketAddressGetPort */ -EXPORT(sqInt) -primitiveSocketAddressGetPort(void) -{ - sqInt addr; - char *addrBase; - sqInt addrSize; - sqInt port; - - addr = stackValue(0); - if (failed()) { - return null; - } - addrSize = byteSizeOf(addr); - addrBase = ((char *) (firstIndexableField(addr))); - if (!(failed())) { - port = sqSocketAddressSizeGetPort(addrBase, addrSize); - if (!(failed())) { - popthenPush(1, integerObjectOf(port)); - return null; - } - } - return null; -} - - /* SocketPlugin>>#primitiveSocketAddressSetPort: */ -EXPORT(sqInt) -primitiveSocketAddressSetPort(void) -{ - sqInt addr; - char *addrBase; - sqInt addrSize; - sqInt portNumber; - - if (!(isIntegerObject(stackValue(0)))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - portNumber = stackIntegerValue(0); - addr = stackValue(1); - if (failed()) { - return null; - } - addrSize = byteSizeOf(addr); - addrBase = ((char *) (firstIndexableField(addr))); - if (!(failed())) { - sqSocketAddressSizeSetPort(addrBase, addrSize, portNumber); - } - if (!(failed())) { - pop(1); - } - return null; -} - - /* SocketPlugin>>#primitiveSocket:bindTo: */ -EXPORT(sqInt) -primitiveSocketBindTo(void) -{ - char *addrBase; - sqInt addrSize; - SocketPtr s; - sqInt socket; - sqInt socketAddress; - - socket = stackValue(1); - socketAddress = stackValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - addrSize = byteSizeOf(socketAddress); - addrBase = ((char *) (firstIndexableField(socketAddress))); - if (!(failed())) { - sqSocketBindToAddressSize(s, addrBase, addrSize); - } - if (!(failed())) { - pop(2); - } - return null; -} - - /* SocketPlugin>>#primitiveSocket:bindTo:port: */ -EXPORT(sqInt) -primitiveSocketBindToPort(void) -{ - sqInt addr; - char *address; - sqInt port; - SocketPtr s; - sqInt socket; - sqInt sz; - - if (!((isBytes(stackValue(1))) - && (isIntegerObject(stackValue(0))))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - socket = stackValue(2); - address = ((char *) (firstIndexableField(stackValue(1)))); - port = stackIntegerValue(0); - if (failed()) { - return null; - } - /* begin netAddressToInt: */ - sz = byteSizeOf(((sqInt)(sqIntptr_t)((((unsigned char *) address))) - BaseHeaderSize)); - if (!(sz == 4)) { - addr = primitiveFail(); - goto l1; - } - addr = ((((((unsigned char *) address))[3]) + (((usqInt)(((((unsigned char *) address))[2])) << 8))) + (((usqInt)(((((unsigned char *) address))[1])) << 16))) + (((usqInt)(((((unsigned char *) address))[0])) << 24)); - l1: /* end netAddressToInt: */; - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - if (!(failed())) { - sqSocketBindToPort(s, addr, port); - } - if (!(failed())) { - pop(3); - } - return null; -} - - /* SocketPlugin>>#primitiveSocketCloseConnection: */ -EXPORT(sqInt) -primitiveSocketCloseConnection(void) -{ - SocketPtr s; - sqInt socket; - - socket = stackValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - if (!(failed())) { - sqSocketCloseConnection(s); - } - if (!(failed())) { - pop(1); - } - return null; -} - - /* SocketPlugin>>#primitiveSocketConnectionStatus: */ -EXPORT(sqInt) -primitiveSocketConnectionStatus(void) -{ - SocketPtr s; - sqInt socket; - sqInt status; - - status = 0; - socket = stackValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - if (!(failed())) { - status = sqSocketConnectionStatus(s); - } - if (!(failed())) { - popthenPush(2, integerObjectOf(status)); - } - return null; -} - - /* SocketPlugin>>#primitiveSocket:connectTo: */ -EXPORT(sqInt) -primitiveSocketConnectTo(void) -{ - char *addrBase; - sqInt addrSize; - SocketPtr s; - sqInt socket; - sqInt socketAddress; - - socket = stackValue(1); - socketAddress = stackValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - addrSize = byteSizeOf(socketAddress); - addrBase = ((char *) (firstIndexableField(socketAddress))); - if (!(failed())) { - sqSocketConnectToAddressSize(s, addrBase, addrSize); - } - if (!(failed())) { - pop(2); - } - return null; -} - - /* SocketPlugin>>#primitiveSocket:connectTo:port: */ -EXPORT(sqInt) -primitiveSocketConnectToPort(void) -{ - sqInt addr; - char *address; - sqInt port; - SocketPtr s; - sqInt socket; - sqInt sz; - - if (!((isBytes(stackValue(1))) - && (isIntegerObject(stackValue(0))))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - socket = stackValue(2); - address = ((char *) (firstIndexableField(stackValue(1)))); - port = stackIntegerValue(0); - if (failed()) { - return null; - } - /* begin netAddressToInt: */ - sz = byteSizeOf(((sqInt)(sqIntptr_t)((((unsigned char *) address))) - BaseHeaderSize)); - if (!(sz == 4)) { - addr = primitiveFail(); - goto l1; - } - addr = ((((((unsigned char *) address))[3]) + (((usqInt)(((((unsigned char *) address))[2])) << 8))) + (((usqInt)(((((unsigned char *) address))[1])) << 16))) + (((usqInt)(((((unsigned char *) address))[0])) << 24)); - l1: /* end netAddressToInt: */; - - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - if (!(failed())) { - sqSocketConnectToPort(s, addr, port); - } - if (!(failed())) { - pop(3); - } - return null; -} - - /* SocketPlugin>>#primitiveSocketCreateNetwork:type:receiveBufferSize:sendBufSize:semaIndex: */ -EXPORT(sqInt) -primitiveSocketCreate(void) -{ - sqInt netType; - sqInt recvBufSize; - SocketPtr s; - sqInt semaIndex; - sqInt sendBufSize; - sqInt socketOop; - sqInt socketType; - - if (!((isIntegerObject(stackValue(4))) - && ((isIntegerObject(stackValue(3))) - && ((isIntegerObject(stackValue(2))) - && ((isIntegerObject(stackValue(1))) - && (isIntegerObject(stackValue(0)))))))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - netType = stackIntegerValue(4); - socketType = stackIntegerValue(3); - recvBufSize = stackIntegerValue(2); - sendBufSize = stackIntegerValue(1); - semaIndex = stackIntegerValue(0); - if (failed()) { - return null; - } - - socketOop = instantiateClassindexableSize(classByteArray(), sizeof(SQSocket)); - /* begin socketValueOf: */ - if ((isBytes(socketOop)) - && ((byteSizeOf(socketOop)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socketOop))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - if (!(failed())) { - sqSocketCreateNetTypeSocketTypeRecvBytesSendBytesSemaID(s, netType, socketType, recvBufSize, sendBufSize, semaIndex); - } - if (!(failed())) { - popthenPush(6, socketOop); - } - return null; -} - - /* SocketPlugin>>#primitiveSocketCreateNetwork:type:receiveBufferSize:sendBufSize:semaIndex:readSemaIndex:writeSemaIndex: */ -EXPORT(sqInt) -primitiveSocketCreate3Semaphores(void) -{ - sqInt aReadSema; - sqInt aWriteSema; - sqInt netType; - sqInt recvBufSize; - SocketPtr s; - sqInt semaIndex; - sqInt sendBufSize; - sqInt socketOop; - sqInt socketType; - - if (!((isIntegerObject(stackValue(6))) - && ((isIntegerObject(stackValue(5))) - && ((isIntegerObject(stackValue(4))) - && ((isIntegerObject(stackValue(3))) - && ((isIntegerObject(stackValue(2))) - && ((isIntegerObject(stackValue(1))) - && (isIntegerObject(stackValue(0)))))))))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - netType = stackIntegerValue(6); - socketType = stackIntegerValue(5); - recvBufSize = stackIntegerValue(4); - sendBufSize = stackIntegerValue(3); - semaIndex = stackIntegerValue(2); - aReadSema = stackIntegerValue(1); - aWriteSema = stackIntegerValue(0); - if (failed()) { - return null; - } - - socketOop = instantiateClassindexableSize(classByteArray(), sizeof(SQSocket)); - /* begin socketValueOf: */ - if ((isBytes(socketOop)) - && ((byteSizeOf(socketOop)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socketOop))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - if (!(failed())) { - sqSocketCreateNetTypeSocketTypeRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(s, netType, socketType, recvBufSize, sendBufSize, semaIndex, aReadSema, aWriteSema); - } - if (!(failed())) { - popthenPush(8, socketOop); - } - return null; -} - - /* SocketPlugin>>#primitiveSocketCreateRaw:type:receiveBufferSize:sendBufSize:semaIndex:readSemaIndex:writeSemaIndex: */ -EXPORT(sqInt) -primitiveSocketCreateRAW(void) -{ - sqInt aReadSema; - sqInt aWriteSema; - sqInt netType; - sqInt protoType; - sqInt recvBufSize; - SocketPtr s; - sqInt semaIndex; - sqInt sendBufSize; - sqInt socketOop; - - if (!((isIntegerObject(stackValue(6))) - && ((isIntegerObject(stackValue(5))) - && ((isIntegerObject(stackValue(4))) - && ((isIntegerObject(stackValue(3))) - && ((isIntegerObject(stackValue(2))) - && ((isIntegerObject(stackValue(1))) - && (isIntegerObject(stackValue(0)))))))))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - netType = stackIntegerValue(6); - protoType = stackIntegerValue(5); - recvBufSize = stackIntegerValue(4); - sendBufSize = stackIntegerValue(3); - semaIndex = stackIntegerValue(2); - aReadSema = stackIntegerValue(1); - aWriteSema = stackIntegerValue(0); - if (failed()) { - return null; - } - - socketOop = instantiateClassindexableSize(classByteArray(), sizeof(SQSocket)); - /* begin socketValueOf: */ - if ((isBytes(socketOop)) - && ((byteSizeOf(socketOop)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socketOop))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - if (!(failed())) { - sqSocketCreateRawProtoTypeRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(s, netType, protoType, recvBufSize, sendBufSize, semaIndex, aReadSema, aWriteSema); - } - if (!(failed())) { - popthenPush(8, socketOop); - } - return null; -} - - /* SocketPlugin>>#primitiveSocketDestroy: */ -EXPORT(sqInt) -primitiveSocketDestroy(void) -{ - SocketPtr s; - sqInt socket; - - socket = stackValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - if (!(failed())) { - sqSocketDestroy(s); - } - if (!(failed())) { - pop(1); - } - return null; -} - - /* SocketPlugin>>#primitiveSocketError: */ -EXPORT(sqInt) -primitiveSocketError(void) -{ - sqInt err; - SocketPtr s; - sqInt socket; - - err = 0; - socket = stackValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - if (!(failed())) { - err = sqSocketError(s); - } - if (!(failed())) { - popthenPush(2, integerObjectOf(err)); - } - return null; -} - - /* SocketPlugin>>#primitiveSocket:getOptions: */ -EXPORT(sqInt) -primitiveSocketGetOptions(void) -{ - sqInt errorCode; - sqInt optionName; - sqInt optionNameSize; - char *optionNameStart; - sqInt results; - sqInt returnedValue; - SocketPtr s; - sqInt socket; - - socket = stackValue(1); - optionName = stackValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - success(isBytes(optionName)); - optionNameStart = ((char *) (firstIndexableField(optionName))); - optionNameSize = slotSizeOf(optionName); - if (failed()) { - return null; - } - returnedValue = 0; - errorCode = sqSocketGetOptionsoptionNameStartoptionNameSizereturnedValue(s, optionNameStart, optionNameSize, (&returnedValue)); - results = instantiateClassindexableSize(classArray(), 2); - storePointerofObjectwithValue(0, results, integerObjectOf(errorCode)); - storePointerofObjectwithValue(1, results, integerObjectOf(returnedValue)); - if (!(failed())) { - popthenPush(3, results); - } - return null; -} - - -/* one part of the wierdass dual prim primitiveSocketListenOnPort which - was warped by some demented evil person determined to twist the very - nature of reality */ - - /* SocketPlugin>>#primitiveSocket:listenOnPort: */ -EXPORT(sqInt) -primitiveSocketListenOnPort(void) -{ - sqInt port; - SocketPtr s; - sqInt socket; - - if (!(isIntegerObject(stackValue(0)))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - socket = stackValue(1); - port = stackIntegerValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - - if (!(failed())) { - sqSocketListenOnPort(s, port); - } - if (!(failed())) { - pop(2); - } - return null; -} - - -/* second part of the wierdass dual prim primitiveSocketListenOnPort - which was warped by some demented evil person determined to twist the - very nature of reality */ - - /* SocketPlugin>>#primitiveSocket:listenOnPort:backlogSize: */ -EXPORT(sqInt) -primitiveSocketListenOnPortBacklog(void) -{ - sqInt backlog; - sqInt port; - SocketPtr s; - sqInt socket; - - if (!((isIntegerObject(stackValue(1))) - && (isIntegerObject(stackValue(0))))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - socket = stackValue(2); - port = stackIntegerValue(1); - backlog = stackIntegerValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - - sqSocketListenOnPortBacklogSize(s, port, backlog); - if (!(failed())) { - pop(3); - } - return null; -} - - -/* Bind a socket to the given port and interface address with no more than - backlog pending connections. The socket can be UDP, in which case the - backlog should be specified as zero. - */ - - /* SocketPlugin>>#primitiveSocket:listenOnPort:backlogSize:interface: */ -EXPORT(sqInt) -primitiveSocketListenOnPortBacklogInterface(void) -{ - sqInt addr; - sqInt backlog; - char *ifAddr; - sqInt okToListen; - sqInt port; - SocketPtr s; - sqInt socket; - sqInt sz; - - if (!((isIntegerObject(stackValue(2))) - && ((isIntegerObject(stackValue(1))) - && (isBytes(stackValue(0)))))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - socket = stackValue(3); - port = stackIntegerValue(2); - backlog = stackIntegerValue(1); - ifAddr = ((char *) (firstIndexableField(stackValue(0)))); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - - /* begin netAddressToInt: */ - sz = byteSizeOf(((sqInt)(sqIntptr_t)((((unsigned char *) ifAddr))) - BaseHeaderSize)); - if (!(sz == 4)) { - addr = primitiveFail(); - goto l1; - } - addr = ((((((unsigned char *) ifAddr))[3]) + (((usqInt)(((((unsigned char *) ifAddr))[2])) << 8))) + (((usqInt)(((((unsigned char *) ifAddr))[1])) << 16))) + (((usqInt)(((((unsigned char *) ifAddr))[0])) << 24)); - l1: /* end netAddressToInt: */; - sqSocketListenOnPortBacklogSizeInterface(s, port, backlog, addr); - if (!(failed())) { - pop(4); - } - return null; -} - - /* SocketPlugin>>#primitiveSocket:listenWithBacklog: */ -EXPORT(sqInt) -primitiveSocketListenWithBacklog(void) -{ - sqInt backlogSize; - SocketPtr s; - sqInt socket; - - if (!(isIntegerObject(stackValue(0)))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - socket = stackValue(1); - backlogSize = stackIntegerValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - if (!(failed())) { - sqSocketListenBacklog(s, backlogSize); - } - if (!(failed())) { - pop(2); - } - return null; -} - - -/* Backward compatibility */ - - /* SocketPlugin>>#primitiveSocketListenWithOrWithoutBacklog */ -EXPORT(sqInt) -primitiveSocketListenWithOrWithoutBacklog(void) -{ - if ((methodArgumentCount()) == 2) { - return primitiveSocketListenOnPort(); - } - else { - return primitiveSocketListenOnPortBacklog(); - } -} - - /* SocketPlugin>>#primitiveSocketLocalAddress: */ -EXPORT(sqInt) -primitiveSocketLocalAddress(void) -{ - sqInt addr; - SocketPtr s; - sqInt socket; - sqInt _return_value; - - socket = stackValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - addr = sqSocketLocalAddress(s); - if (!(failed())) { - _return_value = intToNetAddress(addr); - if (!(failed())) { - popthenPush(2, _return_value); - } - } - return null; -} - - /* SocketPlugin>>#primitiveSocket:localAddressResult: */ -EXPORT(sqInt) -primitiveSocketLocalAddressResult(void) -{ - char *addrBase; - sqInt addrSize; - SocketPtr s; - sqInt socket; - sqInt socketAddress; - - socket = stackValue(1); - socketAddress = stackValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - addrSize = byteSizeOf(socketAddress); - addrBase = ((char *) (firstIndexableField(socketAddress))); - if (!(failed())) { - sqSocketLocalAddressResultSize(s, addrBase, addrSize); - } - if (!(failed())) { - pop(2); - } - return null; -} - - /* SocketPlugin>>#primitiveSocketLocalAddressSize: */ -EXPORT(sqInt) -primitiveSocketLocalAddressSize(void) -{ - SocketPtr s; - sqInt size; - sqInt socket; - - socket = stackValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - if (failed()) { - return null; - } - size = sqSocketLocalAddressSize(s); - if (failed()) { - return null; - } - if (!(failed())) { - popthenPush(2, integerObjectOf(size)); - } - return null; -} - - /* SocketPlugin>>#primitiveSocketLocalPort: */ -EXPORT(sqInt) -primitiveSocketLocalPort(void) -{ - sqInt port; - SocketPtr s; - sqInt socket; - - socket = stackValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - port = sqSocketLocalPort(s); - if (!(failed())) { - popthenPush(2, integerObjectOf(port)); - } - return null; -} - - /* SocketPlugin>>#primitiveSocketReceiveDataAvailable: */ -EXPORT(sqInt) -primitiveSocketReceiveDataAvailable(void) -{ - sqInt dataIsAvailable; - SocketPtr s; - sqInt socket; - - socket = stackValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - dataIsAvailable = sqSocketReceiveDataAvailable(s); - if (!(failed())) { - popthenPush(2, ((dataIsAvailable) ? trueObject() : falseObject())); - } - return null; -} - - /* SocketPlugin>>#primitiveSocket:receiveDataBuf:start:count: */ -EXPORT(sqInt) -primitiveSocketReceiveDataBufCount(void) -{ - sqInt array; - char *arrayBase; - char *bufStart; - sqInt byteSize; - sqInt bytesReceived; - sqInt count; - SocketPtr s; - sqInt socket; - sqInt startIndex; - - bytesReceived = 0; - if (!((isIntegerObject(stackValue(1))) - && (isIntegerObject(stackValue(0))))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - socket = stackValue(3); - array = stackValue(2); - startIndex = stackIntegerValue(1); - count = stackIntegerValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - success(isWordsOrBytes(array)); - if (isWords(array)) { - byteSize = 4; - } - else { - byteSize = 1; - } - success((startIndex >= 1) - && ((count >= 0) - && (((startIndex + count) - 1) <= (slotSizeOf(array))))); - if (!(failed())) { - - /* Note: adjust bufStart for zero-origin indexing */ - arrayBase = ((char *) (firstIndexableField(array))); - bufStart = arrayBase + ((startIndex - 1) * byteSize); - bytesReceived = sqSocketReceiveDataBufCount(s, bufStart, count * byteSize); - } - if (!(failed())) { - popthenPush(5, integerObjectOf((bytesReceived / byteSize))); - } - return null; -} - - /* SocketPlugin>>#primitiveSocket:receiveUDPDataBuf:start:count: */ -EXPORT(sqInt) -primitiveSocketReceiveUDPDataBufCount(void) -{ - sqInt address; - sqInt array; - char *arrayBase; - char *bufStart; - sqInt bytesReceived; - sqInt count; - sqInt elementSize; - sqInt moreFlag; - sqInt port; - sqInt results; - SocketPtr s; - sqInt socket; - sqInt startIndex; - - results = 0; - if (!((isIntegerObject(stackValue(1))) - && (isIntegerObject(stackValue(0))))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - socket = stackValue(3); - array = stackValue(2); - startIndex = stackIntegerValue(1); - count = stackIntegerValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - success(isWordsOrBytes(array)); - if (isWords(array)) { - elementSize = 4; - } - else { - elementSize = 1; - } - success((startIndex >= 1) - && ((count >= 0) - && (((startIndex + count) - 1) <= (slotSizeOf(array))))); - if (!(failed())) { - - /* Note: adjust bufStart for zero-origin indexing */ - arrayBase = ((char *) (firstIndexableField(array))); - bufStart = arrayBase + ((startIndex - 1) * elementSize); - address = 0; - port = 0; - moreFlag = 0; - - /* allocate storage for results, remapping newly allocated - oops in case GC happens during allocation */ - bytesReceived = sqSocketReceiveUDPDataBufCountaddressportmoreFlag(s, bufStart, count * elementSize, (&address), (&port), (&moreFlag)); - pushRemappableOop(intToNetAddress(address)); - results = instantiateClassindexableSize(classArray(), 4); - storePointerofObjectwithValue(0, results, integerObjectOf((bytesReceived / elementSize))); - storePointerofObjectwithValue(1, results, popRemappableOop()); - storePointerofObjectwithValue(2, results, integerObjectOf(port)); - storePointerofObjectwithValue(3, results, (moreFlag - ? trueObject() - : falseObject())); - } - if (!(failed())) { - popthenPush(5, results); - } - return null; -} - - /* SocketPlugin>>#primitiveSocketRemoteAddress: */ -EXPORT(sqInt) -primitiveSocketRemoteAddress(void) -{ - sqInt addr; - SocketPtr s; - sqInt socket; - sqInt _return_value; - - socket = stackValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - addr = sqSocketRemoteAddress(s); - if (!(failed())) { - _return_value = intToNetAddress(addr); - if (!(failed())) { - popthenPush(2, _return_value); - } - } - return null; -} - - /* SocketPlugin>>#primitiveSocket:remoteAddressResult: */ -EXPORT(sqInt) -primitiveSocketRemoteAddressResult(void) -{ - char *addrBase; - sqInt addrSize; - SocketPtr s; - sqInt socket; - sqInt socketAddress; - - socket = stackValue(1); - socketAddress = stackValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - addrSize = byteSizeOf(socketAddress); - addrBase = ((char *) (firstIndexableField(socketAddress))); - if (!(failed())) { - sqSocketRemoteAddressResultSize(s, addrBase, addrSize); - } - if (!(failed())) { - pop(2); - } - return null; -} - - /* SocketPlugin>>#primitiveSocketRemoteAddressSize: */ -EXPORT(sqInt) -primitiveSocketRemoteAddressSize(void) -{ - SocketPtr s; - sqInt size; - sqInt socket; - - socket = stackValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - if (failed()) { - return null; - } - size = sqSocketRemoteAddressSize(s); - if (failed()) { - return null; - } - if (!(failed())) { - popthenPush(2, integerObjectOf(size)); - } - return null; -} - - /* SocketPlugin>>#primitiveSocketRemotePort: */ -EXPORT(sqInt) -primitiveSocketRemotePort(void) -{ - sqInt port; - SocketPtr s; - sqInt socket; - - socket = stackValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - port = sqSocketRemotePort(s); - if (!(failed())) { - popthenPush(2, integerObjectOf(port)); - } - return null; -} - - /* SocketPlugin>>#primitiveSocket:sendData:start:count: */ -EXPORT(sqInt) -primitiveSocketSendDataBufCount(void) -{ - sqInt array; - char *arrayBase; - char *bufStart; - sqInt byteSize; - sqInt bytesSent; - sqInt count; - SocketPtr s; - sqInt socket; - sqInt startIndex; - - bytesSent = 0; - if (!((isIntegerObject(stackValue(1))) - && (isIntegerObject(stackValue(0))))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - socket = stackValue(3); - array = stackValue(2); - startIndex = stackIntegerValue(1); - count = stackIntegerValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - success(isWordsOrBytes(array)); - if (isWords(array)) { - byteSize = 4; - } - else { - byteSize = 1; - } - success((startIndex >= 1) - && ((count >= 0) - && (((startIndex + count) - 1) <= (slotSizeOf(array))))); - if (!(failed())) { - - /* Note: adjust bufStart for zero-origin indexing */ - arrayBase = ((char *) (firstIndexableField(array))); - bufStart = arrayBase + ((startIndex - 1) * byteSize); - bytesSent = sqSocketSendDataBufCount(s, bufStart, count * byteSize); - } - if (!(failed())) { - popthenPush(5, integerObjectOf((bytesSent / byteSize))); - } - return null; -} - - /* SocketPlugin>>#primitiveSocketSendDone: */ -EXPORT(sqInt) -primitiveSocketSendDone(void) -{ - sqInt done; - SocketPtr s; - sqInt socket; - - socket = stackValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - done = sqSocketSendDone(s); - if (!(failed())) { - popthenPush(2, ((done) ? trueObject() : falseObject())); - } - return null; -} - - /* SocketPlugin>>#primitiveSocket:sendUDPData:toHost:port:start:count: */ -EXPORT(sqInt) -primitiveSocketSendUDPDataBufCount(void) -{ - sqInt address; - sqInt array; - char *arrayBase; - char *bufStart; - sqInt byteSize; - sqInt bytesSent; - sqInt count; - char *hostAddress; - sqInt portNumber; - SocketPtr s; - sqInt socket; - sqInt startIndex; - sqInt sz; - - bytesSent = 0; - if (!((isBytes(stackValue(3))) - && ((isIntegerObject(stackValue(2))) - && ((isIntegerObject(stackValue(1))) - && (isIntegerObject(stackValue(0))))))) { - primitiveFailFor(PrimErrBadArgument); - return null; - } - socket = stackValue(5); - array = stackValue(4); - hostAddress = ((char *) (firstIndexableField(stackValue(3)))); - portNumber = stackIntegerValue(2); - startIndex = stackIntegerValue(1); - count = stackIntegerValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - success(isWordsOrBytes(array)); - if (isWords(array)) { - byteSize = 4; - } - else { - byteSize = 1; - } - success((startIndex >= 1) - && ((count >= 0) - && (((startIndex + count) - 1) <= (slotSizeOf(array))))); - if (!(failed())) { - - /* Note: adjust bufStart for zero-origin indexing */ - arrayBase = ((char *) (firstIndexableField(array))); - bufStart = arrayBase + ((startIndex - 1) * byteSize); - /* begin netAddressToInt: */ - sz = byteSizeOf(((sqInt)(sqIntptr_t)((((unsigned char *) hostAddress))) - BaseHeaderSize)); - if (!(sz == 4)) { - address = primitiveFail(); - goto l1; - } - address = ((((((unsigned char *) hostAddress))[3]) + (((usqInt)(((((unsigned char *) hostAddress))[2])) << 8))) + (((usqInt)(((((unsigned char *) hostAddress))[1])) << 16))) + (((usqInt)(((((unsigned char *) hostAddress))[0])) << 24)); - l1: /* end netAddressToInt: */; - bytesSent = sqSockettoHostportSendDataBufCount(s, address, portNumber, bufStart, count * byteSize); - } - if (!(failed())) { - popthenPush(7, integerObjectOf((bytesSent / byteSize))); - } - return null; -} - - -/* THIS BADLY NEEDS TO BE REWRITTEN TO TAKE Booleans AND Integers AS WELL AS - (OR INSTEAD OF) Strings. - It is only used with booleans and integers and parsing these back out of - strings in - - sqSocketSetOptions:optionNameStart:optionNameSize:optionValueStart:optionValueSize:returnedValue: - is STUPID. */ - - /* SocketPlugin>>#primitiveSocket:setOptions:value: */ -EXPORT(sqInt) -primitiveSocketSetOptions(void) -{ - sqInt errorCode; - sqInt optionName; - sqInt optionNameSize; - char *optionNameStart; - sqInt optionValue; - sqInt optionValueSize; - char *optionValueStart; - sqInt results; - sqInt returnedValue; - SocketPtr s; - sqInt socket; - - socket = stackValue(2); - optionName = stackValue(1); - optionValue = stackValue(0); - if (failed()) { - return null; - } - /* begin socketValueOf: */ - if ((isBytes(socket)) - && ((byteSizeOf(socket)) == (sizeof(SQSocket)))) { - s = ((SocketPtr) (firstIndexableField(socket))); - } - else { - primitiveFailFor(PrimErrBadArgument); - s = null; - } - success(isBytes(optionName)); - optionNameStart = ((char *) (firstIndexableField(optionName))); - optionNameSize = slotSizeOf(optionName); - success(isBytes(optionValue)); - optionValueStart = ((char *) (firstIndexableField(optionValue))); - optionValueSize = slotSizeOf(optionValue); - if (failed()) { - return null; - } - returnedValue = 0; - errorCode = sqSocketSetOptionsoptionNameStartoptionNameSizeoptionValueStartoptionValueSizereturnedValue(s, optionNameStart, optionNameSize, optionValueStart, optionValueSize, (&returnedValue)); - results = instantiateClassindexableSize(classArray(), 2); - storePointerofObjectwithValue(0, results, integerObjectOf(errorCode)); - storePointerofObjectwithValue(1, results, integerObjectOf(returnedValue)); - if (!(failed())) { - popthenPush(4, results); - } - return null; -} - - -/* Note: This is coded so that it can be run in Squeak. */ - - /* InterpreterPlugin>>#setInterpreter: */ -EXPORT(sqInt) -setInterpreter(struct VirtualMachine *anInterpreter) -{ - sqInt ok; - - interpreterProxy = anInterpreter; - ok = ((interpreterProxy->majorVersion()) == (VM_PROXY_MAJOR)) - && ((interpreterProxy->minorVersion()) >= (VM_PROXY_MINOR)); - if (ok) { - -#if !defined(SQUEAK_BUILTIN_PLUGIN) - byteSizeOf = interpreterProxy->byteSizeOf; - classArray = interpreterProxy->classArray; - classByteArray = interpreterProxy->classByteArray; - classString = interpreterProxy->classString; - failed = interpreterProxy->failed; - falseObject = interpreterProxy->falseObject; - firstIndexableField = interpreterProxy->firstIndexableField; - instantiateClassindexableSize = interpreterProxy->instantiateClassindexableSize; - integerObjectOf = interpreterProxy->integerObjectOf; - ioLoadFunctionFrom = interpreterProxy->ioLoadFunctionFrom; - isBytes = interpreterProxy->isBytes; - isIntegerObject = interpreterProxy->isIntegerObject; - isWords = interpreterProxy->isWords; - isWordsOrBytes = interpreterProxy->isWordsOrBytes; - methodArgumentCount = interpreterProxy->methodArgumentCount; - pop = interpreterProxy->pop; - popthenPush = interpreterProxy->popthenPush; - popRemappableOop = interpreterProxy->popRemappableOop; - primitiveFail = interpreterProxy->primitiveFail; - primitiveFailFor = interpreterProxy->primitiveFailFor; - pushRemappableOop = interpreterProxy->pushRemappableOop; - slotSizeOf = interpreterProxy->slotSizeOf; - stackIntegerValue = interpreterProxy->stackIntegerValue; - stackValue = interpreterProxy->stackValue; - storePointerofObjectwithValue = interpreterProxy->storePointerofObjectwithValue; - success = interpreterProxy->success; - trueObject = interpreterProxy->trueObject; -#endif /* !defined(SQUEAK_BUILTIN_PLUGIN) */ - } - return ok; -} - - /* SocketPlugin>>#shutdownModule */ -EXPORT(sqInt) -shutdownModule(void) -{ - return socketShutdown(); -} - - -/* Return the size of a Smalltalk socket record in bytes. */ - - /* SocketPlugin>>#socketRecordSize */ -static sqInt -socketRecordSize(void) -{ - return sizeof(SQSocket); -} - - -/* Answer a pointer to the first byte of of the socket record within the - given Smalltalk object, or nil if socketOop is not a socket record. */ - - /* SocketPlugin>>#socketValueOf: */ -static SocketPtr -socketValueOf(sqInt socketOop) -{ - return ((isBytes(socketOop)) - && ((byteSizeOf(socketOop)) == (sizeof(SQSocket))) - ? ((SocketPtr) (firstIndexableField(socketOop))) - : (primitiveFailFor(PrimErrBadArgument), - null)); -} - - /* SmartSyntaxInterpreterPlugin>>#sqAssert: */ -static sqInt -sqAssert(sqInt aBool) -{ - /* missing DebugCode */; - return aBool; -} - - -#ifdef SQUEAK_BUILTIN_PLUGIN - -static char _m[] = "SocketPlugin"; -void* SocketPlugin_exports[][3] = { - {(void*)_m, "getModuleName", (void*)getModuleName}, - {(void*)_m, "initialiseModule", (void*)initialiseModule}, - {(void*)_m, "moduleUnloaded", (void*)moduleUnloaded}, - {(void*)_m, "primitiveInitializeNetwork\000\000", (void*)primitiveInitializeNetwork}, - {(void*)_m, "primitiveResolverAbortLookup\000\377", (void*)primitiveResolverAbortLookup}, - {(void*)_m, "primitiveResolverAddressLookupResult\000\377", (void*)primitiveResolverAddressLookupResult}, - {(void*)_m, "primitiveResolverError\000\377", (void*)primitiveResolverError}, - {(void*)_m, "primitiveResolverGetAddressInfo\000\000", (void*)primitiveResolverGetAddressInfo}, - {(void*)_m, "primitiveResolverGetAddressInfoFamily\000\377", (void*)primitiveResolverGetAddressInfoFamily}, - {(void*)_m, "primitiveResolverGetAddressInfoNext\000\377", (void*)primitiveResolverGetAddressInfoNext}, - {(void*)_m, "primitiveResolverGetAddressInfoProtocol\000\377", (void*)primitiveResolverGetAddressInfoProtocol}, - {(void*)_m, "primitiveResolverGetAddressInfoResult\000\377", (void*)primitiveResolverGetAddressInfoResult}, - {(void*)_m, "primitiveResolverGetAddressInfoSize\000\377", (void*)primitiveResolverGetAddressInfoSize}, - {(void*)_m, "primitiveResolverGetAddressInfoType\000\377", (void*)primitiveResolverGetAddressInfoType}, - {(void*)_m, "primitiveResolverGetNameInfo\000\000", (void*)primitiveResolverGetNameInfo}, - {(void*)_m, "primitiveResolverGetNameInfoHostResult\000\377", (void*)primitiveResolverGetNameInfoHostResult}, - {(void*)_m, "primitiveResolverGetNameInfoHostSize\000\377", (void*)primitiveResolverGetNameInfoHostSize}, - {(void*)_m, "primitiveResolverGetNameInfoServiceResult\000\377", (void*)primitiveResolverGetNameInfoServiceResult}, - {(void*)_m, "primitiveResolverGetNameInfoServiceSize\000\377", (void*)primitiveResolverGetNameInfoServiceSize}, - {(void*)_m, "primitiveResolverHostNameResult\000\377", (void*)primitiveResolverHostNameResult}, - {(void*)_m, "primitiveResolverHostNameSize\000\377", (void*)primitiveResolverHostNameSize}, - {(void*)_m, "primitiveResolverLocalAddress\000\377", (void*)primitiveResolverLocalAddress}, - {(void*)_m, "primitiveResolverNameLookupResult\000\377", (void*)primitiveResolverNameLookupResult}, - {(void*)_m, "primitiveResolverStartAddressLookup\000\377", (void*)primitiveResolverStartAddressLookup}, - {(void*)_m, "primitiveResolverStartNameLookup\000\377", (void*)primitiveResolverStartNameLookup}, - {(void*)_m, "primitiveResolverStatus\000\377", (void*)primitiveResolverStatus}, - {(void*)_m, "primitiveSocketAbortConnection\000\000", (void*)primitiveSocketAbortConnection}, - {(void*)_m, "primitiveSocketAccept\000\000", (void*)primitiveSocketAccept}, - {(void*)_m, "primitiveSocketAccept3Semaphores\000\000", (void*)primitiveSocketAccept3Semaphores}, - {(void*)_m, "primitiveSocketAddressGetPort\000\000", (void*)primitiveSocketAddressGetPort}, - {(void*)_m, "primitiveSocketAddressSetPort\000\000", (void*)primitiveSocketAddressSetPort}, - {(void*)_m, "primitiveSocketBindTo\000\000", (void*)primitiveSocketBindTo}, - {(void*)_m, "primitiveSocketBindToPort\000\000", (void*)primitiveSocketBindToPort}, - {(void*)_m, "primitiveSocketCloseConnection\000\000", (void*)primitiveSocketCloseConnection}, - {(void*)_m, "primitiveSocketConnectionStatus\000\000", (void*)primitiveSocketConnectionStatus}, - {(void*)_m, "primitiveSocketConnectTo\000\000", (void*)primitiveSocketConnectTo}, - {(void*)_m, "primitiveSocketConnectToPort\000\000", (void*)primitiveSocketConnectToPort}, - {(void*)_m, "primitiveSocketCreate\000\000", (void*)primitiveSocketCreate}, - {(void*)_m, "primitiveSocketCreate3Semaphores\000\000", (void*)primitiveSocketCreate3Semaphores}, - {(void*)_m, "primitiveSocketCreateRAW\000\000", (void*)primitiveSocketCreateRAW}, - {(void*)_m, "primitiveSocketDestroy\000\000", (void*)primitiveSocketDestroy}, - {(void*)_m, "primitiveSocketError\000\000", (void*)primitiveSocketError}, - {(void*)_m, "primitiveSocketGetOptions\000\000", (void*)primitiveSocketGetOptions}, - {(void*)_m, "primitiveSocketListenOnPort\000\000", (void*)primitiveSocketListenOnPort}, - {(void*)_m, "primitiveSocketListenOnPortBacklog\000\000", (void*)primitiveSocketListenOnPortBacklog}, - {(void*)_m, "primitiveSocketListenOnPortBacklogInterface\000\000", (void*)primitiveSocketListenOnPortBacklogInterface}, - {(void*)_m, "primitiveSocketListenWithBacklog\000\000", (void*)primitiveSocketListenWithBacklog}, - {(void*)_m, "primitiveSocketListenWithOrWithoutBacklog\000\000", (void*)primitiveSocketListenWithOrWithoutBacklog}, - {(void*)_m, "primitiveSocketLocalAddress\000\000", (void*)primitiveSocketLocalAddress}, - {(void*)_m, "primitiveSocketLocalAddressResult\000\000", (void*)primitiveSocketLocalAddressResult}, - {(void*)_m, "primitiveSocketLocalAddressSize\000\000", (void*)primitiveSocketLocalAddressSize}, - {(void*)_m, "primitiveSocketLocalPort\000\000", (void*)primitiveSocketLocalPort}, - {(void*)_m, "primitiveSocketReceiveDataAvailable\000\000", (void*)primitiveSocketReceiveDataAvailable}, - {(void*)_m, "primitiveSocketReceiveDataBufCount\000\000", (void*)primitiveSocketReceiveDataBufCount}, - {(void*)_m, "primitiveSocketReceiveUDPDataBufCount\000\000", (void*)primitiveSocketReceiveUDPDataBufCount}, - {(void*)_m, "primitiveSocketRemoteAddress\000\000", (void*)primitiveSocketRemoteAddress}, - {(void*)_m, "primitiveSocketRemoteAddressResult\000\000", (void*)primitiveSocketRemoteAddressResult}, - {(void*)_m, "primitiveSocketRemoteAddressSize\000\000", (void*)primitiveSocketRemoteAddressSize}, - {(void*)_m, "primitiveSocketRemotePort\000\000", (void*)primitiveSocketRemotePort}, - {(void*)_m, "primitiveSocketSendDataBufCount\000\000", (void*)primitiveSocketSendDataBufCount}, - {(void*)_m, "primitiveSocketSendDone\000\000", (void*)primitiveSocketSendDone}, - {(void*)_m, "primitiveSocketSendUDPDataBufCount\000\000", (void*)primitiveSocketSendUDPDataBufCount}, - {(void*)_m, "primitiveSocketSetOptions\000\000", (void*)primitiveSocketSetOptions}, - {(void*)_m, "setInterpreter", (void*)setInterpreter}, - {(void*)_m, "shutdownModule\000\377", (void*)shutdownModule}, - {NULL, NULL, NULL} -}; - -#else /* ifdef SQ_BUILTIN_PLUGIN */ - -EXPORT(signed char) primitiveInitializeNetworkAccessorDepth = 0; -EXPORT(signed char) primitiveResolverGetAddressInfoAccessorDepth = 0; -EXPORT(signed char) primitiveResolverGetNameInfoAccessorDepth = 0; -EXPORT(signed char) primitiveSocketAbortConnectionAccessorDepth = 0; -EXPORT(signed char) primitiveSocketAcceptAccessorDepth = 0; -EXPORT(signed char) primitiveSocketAccept3SemaphoresAccessorDepth = 0; -EXPORT(signed char) primitiveSocketAddressGetPortAccessorDepth = 0; -EXPORT(signed char) primitiveSocketAddressSetPortAccessorDepth = 0; -EXPORT(signed char) primitiveSocketBindToAccessorDepth = 0; -EXPORT(signed char) primitiveSocketBindToPortAccessorDepth = 0; -EXPORT(signed char) primitiveSocketCloseConnectionAccessorDepth = 0; -EXPORT(signed char) primitiveSocketConnectionStatusAccessorDepth = 0; -EXPORT(signed char) primitiveSocketConnectToAccessorDepth = 0; -EXPORT(signed char) primitiveSocketConnectToPortAccessorDepth = 0; -EXPORT(signed char) primitiveSocketCreateAccessorDepth = 0; -EXPORT(signed char) primitiveSocketCreate3SemaphoresAccessorDepth = 0; -EXPORT(signed char) primitiveSocketCreateRAWAccessorDepth = 0; -EXPORT(signed char) primitiveSocketDestroyAccessorDepth = 0; -EXPORT(signed char) primitiveSocketErrorAccessorDepth = 0; -EXPORT(signed char) primitiveSocketGetOptionsAccessorDepth = 0; -EXPORT(signed char) primitiveSocketListenOnPortAccessorDepth = 0; -EXPORT(signed char) primitiveSocketListenOnPortBacklogAccessorDepth = 0; -EXPORT(signed char) primitiveSocketListenOnPortBacklogInterfaceAccessorDepth = 0; -EXPORT(signed char) primitiveSocketListenWithBacklogAccessorDepth = 0; -EXPORT(signed char) primitiveSocketListenWithOrWithoutBacklogAccessorDepth = 0; -EXPORT(signed char) primitiveSocketLocalAddressAccessorDepth = 0; -EXPORT(signed char) primitiveSocketLocalAddressResultAccessorDepth = 0; -EXPORT(signed char) primitiveSocketLocalAddressSizeAccessorDepth = 0; -EXPORT(signed char) primitiveSocketLocalPortAccessorDepth = 0; -EXPORT(signed char) primitiveSocketReceiveDataAvailableAccessorDepth = 0; -EXPORT(signed char) primitiveSocketReceiveDataBufCountAccessorDepth = 0; -EXPORT(signed char) primitiveSocketReceiveUDPDataBufCountAccessorDepth = 0; -EXPORT(signed char) primitiveSocketRemoteAddressAccessorDepth = 0; -EXPORT(signed char) primitiveSocketRemoteAddressResultAccessorDepth = 0; -EXPORT(signed char) primitiveSocketRemoteAddressSizeAccessorDepth = 0; -EXPORT(signed char) primitiveSocketRemotePortAccessorDepth = 0; -EXPORT(signed char) primitiveSocketSendDataBufCountAccessorDepth = 0; -EXPORT(signed char) primitiveSocketSendDoneAccessorDepth = 0; -EXPORT(signed char) primitiveSocketSendUDPDataBufCountAccessorDepth = 0; -EXPORT(signed char) primitiveSocketSetOptionsAccessorDepth = 0; - -#endif /* ifdef SQ_BUILTIN_PLUGIN */ diff --git a/plugins.cmake b/plugins.cmake index e9abd9e5e4..d1a006f286 100644 --- a/plugins.cmake +++ b/plugins.cmake @@ -89,10 +89,23 @@ endif() # Socket Plugin # if (${FEATURE_NETWORK}) - add_vm_plugin(SocketPlugin) - if(WIN) - target_link_libraries(SocketPlugin PRIVATE "-lWs2_32") - endif() + + message(STATUS "Adding plugin: SocketPlugin") + + include_directories( + ${CMAKE_CURRENT_SOURCE_DIR}/plugins/SocketPlugin/include + ) + + file(GLOB SocketPlugin_SOURCES + ${CMAKE_CURRENT_SOURCE_DIR}/plugins/SocketPlugin/src/*.c + ${PHARO_CURRENT_GENERATED}/plugins/src/SocketPlugin/SocketPlugin.c + ) + + addLibraryWithRPATH(SocketPlugin ${SocketPlugin_SOURCES}) + + if(WIN) + target_link_libraries(SocketPlugin PRIVATE "-lWs2_32") + endif() endif() # diff --git a/extracted/plugins/SocketPlugin/include/common/SocketPlugin.h b/plugins/SocketPlugin/include/SocketPlugin.h similarity index 100% rename from extracted/plugins/SocketPlugin/include/common/SocketPlugin.h rename to plugins/SocketPlugin/include/SocketPlugin.h diff --git a/extracted/plugins/SocketPlugin/src/common/SocketPluginImpl.c b/plugins/SocketPlugin/src/SocketPluginImpl.c similarity index 100% rename from extracted/plugins/SocketPlugin/src/common/SocketPluginImpl.c rename to plugins/SocketPlugin/src/SocketPluginImpl.c From 96e6cdd7e22d2c8b34dfb2d632b94510bd6bb23e Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Thu, 2 Sep 2021 17:51:51 +0200 Subject: [PATCH 03/16] Making the Socket plugin to be generated. --- .../SmartSyntaxInterpreterPlugin.class.st | 8 - .../SmartSyntaxPluginCodeGenerator.class.st | 174 +++++++++--------- .../VMMaker/SmartSyntaxPluginTMethod.class.st | 2 +- .../PharoVMMaker.class.st | 6 +- .../RBVariableNode.extension.st | 4 + 5 files changed, 99 insertions(+), 95 deletions(-) diff --git a/smalltalksrc/VMMaker/SmartSyntaxInterpreterPlugin.class.st b/smalltalksrc/VMMaker/SmartSyntaxInterpreterPlugin.class.st index 7871f27833..4965873315 100644 --- a/smalltalksrc/VMMaker/SmartSyntaxInterpreterPlugin.class.st +++ b/smalltalksrc/VMMaker/SmartSyntaxInterpreterPlugin.class.st @@ -108,11 +108,3 @@ SmartSyntaxInterpreterPlugin >> simulator: aSmartSyntaxPluginSimulator [ simulator := aSmartSyntaxPluginSimulator ] - -{ #category : #debugging } -SmartSyntaxInterpreterPlugin >> sqAssert: aBool [ - self debugCode: - [aBool ifFalse: - [self error: 'Assertion failed!']]. - ^aBool -] diff --git a/smalltalksrc/VMMaker/SmartSyntaxPluginCodeGenerator.class.st b/smalltalksrc/VMMaker/SmartSyntaxPluginCodeGenerator.class.st index 27cb41ac42..af11a861fe 100644 --- a/smalltalksrc/VMMaker/SmartSyntaxPluginCodeGenerator.class.st +++ b/smalltalksrc/VMMaker/SmartSyntaxPluginCodeGenerator.class.st @@ -344,15 +344,6 @@ SmartSyntaxPluginCodeGenerator >> ccgValBlock: valString [ nextPutAll: '))']] ] -{ #category : #'translating builtins' } -SmartSyntaxPluginCodeGenerator >> genCallOf: aSelector with: aNode on: aStream [ - pluginFunctionsUsed add: aSelector. - aStream nextPutAll: (self cFunctionNameFor: aSelector). - aStream nextPut: $(. - self emitCExpression: aNode on: aStream. - aStream nextPut: $) -] - { #category : #'translating builtins' } SmartSyntaxPluginCodeGenerator >> genCallOf: aSelector with: firstArgNode with: secondArgNode on: aStream [ pluginFunctionsUsed add: aSelector. @@ -377,12 +368,17 @@ SmartSyntaxPluginCodeGenerator >> genCallOf: aSelector with: firstArgNode with: aStream nextPut: $) ] -{ #category : #'translating builtins' } -SmartSyntaxPluginCodeGenerator >> generateAsBooleanObj: aNode on: aStream indent: anInteger [ - pluginFunctionsUsed add: #trueObject; add: #falseObject. - aStream nextPutAll: '(('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ') ? trueObject() : falseObject())'. +{ #category : #'CAST translation' } +SmartSyntaxPluginCodeGenerator >> generateAsBooleanObj: aTSendNode [ + + pluginFunctionsUsed + add: #trueObject; + add: #falseObject. + + ^ CTernaryNode + condition: (aTSendNode receiver asCASTExpressionIn: self) + then: (CCallNode identifier: (CIdentifierNode name: #trueObject)) + else: (CCallNode identifier: (CIdentifierNode name: #falseObject)) ] { #category : #'translating builtins' } @@ -405,9 +401,10 @@ SmartSyntaxPluginCodeGenerator >> generateAsCUnsigned: aNode on: aStream indent: self genCallOf: #positive32BitValueOf: with: aNode receiver on: aStream ] -{ #category : #'translating builtins' } -SmartSyntaxPluginCodeGenerator >> generateAsCharPtr: aNode on: aStream indent: anInteger [ - self generateCoerceToPtr: 'char *' fromObject: aNode receiver on: aStream +{ #category : #'CAST translation' } +SmartSyntaxPluginCodeGenerator >> generateAsCharPtr: aNode [ + + ^ self generateCoerceToPtr: #'char*' fromObject: aNode receiver ] { #category : #'translating builtins' } @@ -499,9 +496,15 @@ SmartSyntaxPluginCodeGenerator >> generateAsPositiveIntegerObj: aNode on: aStrea self genCallOf: #positive32BitIntegerFor: with: aNode receiver on: aStream ] -{ #category : #'translating builtins' } -SmartSyntaxPluginCodeGenerator >> generateAsSmallIntegerObj: aNode on: aStream indent: anInteger [ - self genCallOf: #integerObjectOf: with: aNode receiver on: aStream +{ #category : #'CAST translation' } +SmartSyntaxPluginCodeGenerator >> generateAsSmallIntegerObj: expr [ + + pluginFunctionsUsed + add: #integerObjectOf:. + + ^ CCallNode + identifier: (CIdentifierNode name: 'integerObjectOf') + arguments: { (expr receiver asCASTExpressionIn: self) } ] { #category : #'translating builtins' } @@ -517,11 +520,18 @@ SmartSyntaxPluginCodeGenerator >> generateAsValue: aNode on: aStream indent: anI class ccg: self generateCoerceToValueFrom: aNode receiver on: aStream ] -{ #category : #'translating builtins' } -SmartSyntaxPluginCodeGenerator >> generateCPtrAsOop: aNode on: aStream indent: anInteger [ - aStream nextPutAll: '((sqInt)(sqIntptr_t)('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ') - BaseHeaderSize)' +{ #category : #'CAST translation' } +SmartSyntaxPluginCodeGenerator >> generateCPtrAsOop: expr [ + + ^ CCastExpressionNode + type: (CTypeNameNode symbol: #sqInt) + expression: (CBinaryOperatorNode + operator: #- + left: (CCastExpressionNode + type: (CTypeNameNode symbol: #sqIntptr_t) + expression: (expr receiver asCASTExpressionIn: self)) + right: (CIdentifierNode name: 'BaseHeaderSize')) + ] { #category : #'translating builtins' } @@ -561,15 +571,17 @@ SmartSyntaxPluginCodeGenerator >> generateCoerceToObjectFromPtr: aNode on: aStre aStream nextPutAll: ') - BaseHeaderSize))' ] -{ #category : #'asOop:/asValue:' } -SmartSyntaxPluginCodeGenerator >> generateCoerceToPtr: aString fromObject: aNode on: aStream [ +{ #category : #'CAST translation' } +SmartSyntaxPluginCodeGenerator >> generateCoerceToPtr: cType fromObject: expr [ + "This code assumes no named instance variables" - aStream - nextPutAll: '(('; - nextPutAll: aString; - nextPut: $). - self genCallOf: #firstIndexableField: with: aNode on: aStream. - aStream nextPut: $) + + ^ CCastExpressionNode + type: (CTypeNameNode symbol: cType) + expression: (CCallNode + identifier: (CIdentifierNode name: 'firstIndexableField') + arguments: { (expr asCASTExpressionIn: self) }) + ] { #category : #'asOop:/asValue:' } @@ -718,63 +730,59 @@ SmartSyntaxPluginCodeGenerator >> initialize [ ] { #category : #'translating builtins' } -SmartSyntaxPluginCodeGenerator >> initializeCTranslationDictionary [ +SmartSyntaxPluginCodeGenerator >> initializeCASTTranslationDictionary [ "Initialize the dictionary mapping message names to actions for C code generation." | pairs | - super initializeCTranslationDictionary. + super initializeCASTTranslationDictionary. + pairs := #( - #asCInt #generateAsCInt:on:indent: - #asCUnsigned #generateAsCUnsigned:on:indent: - #asCBoolean #generateAsCBoolean:on:indent: - #asCDouble #generateAsCDouble:on:indent: - - #asSmallIntegerObj #generateAsSmallIntegerObj:on:indent: - #asPositiveIntegerObj #generateAsPositiveIntegerObj:on:indent: - #asBooleanObj #generateAsBooleanObj:on:indent: - #asFloatObj #generateAsFloatObj:on:indent: - - #asIf:var: #generateAsIfVar:on:indent: - #asIf:var:asValue: #generateAsIfVarAsValue:on:indent: - #asIf:var:put: #generateAsIfVarPut:on:indent: - #field: #generateField:on:indent: - #field:put: #generateFieldPut:on:indent: + #asCInt #generateAsCInt: + #asCUnsigned #generateAsCUnsigned: + #asCBoolean #generateAsCBoolean: + #asCDouble #generateAsCDouble: + + #asSmallIntegerObj #generateAsSmallIntegerObj: + #asPositiveIntegerObj #generateAsPositiveIntegerObj: + #asBooleanObj #generateAsBooleanObj: + #asFloatObj #generateAsFloatObj: + + #asIf:var: #generateAsIfVar: + #asIf:var:asValue: #generateAsIfVarAsValue: + #asIf:var:put: #generateAsIfVarPut: + #field: #generateField: + #field:put: #generateFieldPut: - #class #generateClass:on:indent: - - #stSize #generateStSize:on:indent: - #stAt: #generateStAt:on:indent: - #stAt:put: #generateStAtPut:on:indent: - - #asCharPtr #generateAsCharPtr:on:indent: - #asIntPtr #generateAsIntPtr:on:indent: - #cPtrAsOop #generateCPtrAsOop:on:indent: - #next #generateNext:on:indent: - - #asOop: #generateAsOop:on:indent: - #asValue: #generateAsValue:on:indent: - - #isFloat #generateIsFloat:on:indent: - #isIndexable #generateIsIndexable:on:indent: - #isIntegerOop #generateIsIntegerOop:on:indent: - #isIntegerValue #generateIsIntegerValue:on:indent: - "#FloatOop #generateIsFloatValue:on:indent:" "unused, never implemented" - #isWords #generateIsWords:on:indent: - #isWordsOrBytes #generateIsWordsOrBytes:on:indent: - #isPointers #generateIsPointers:on:indent: - #isNil #generateCASTIsNil: - #isMemberOf: #generateIsMemberOf:on:indent: - #isKindOf: #generateIsKindOf:on:indent: - - #fromStack: #generateFromStack:on:indent: - "#clone #generateClone:on:indent:" "unused, never implemented" - "#new #generateNew:on:indent:" "unused, never implemented" - "#new: #generateNewSize:on:indent:" "unused, never implemented" - "#superclass #generateSuperclass:on:indent:" "unused, never implemented" + #class #generateClass: + + #stSize #generateStSize: + #stAt: #generateStAt: + #stAt:put: #generateStAtPut: + + #asCharPtr #generateAsCharPtr: + #asIntPtr #generateAsIntPtr: + #cPtrAsOop #generateCPtrAsOop: + #next #generateNext: + + #asOop: #generateAsOop: + #asValue: #generateAsValue: + + #isFloat #generateIsFloat: + #isIndexable #generateIsIndexable: + #isIntegerOop #generateIsIntegerOop: + #isIntegerValue #generateIsIntegerValue: + #isWords #generateIsWords: + #isWordsOrBytes #generateIsWordsOrBytes: + #isPointers #generateIsPointers: + #isNil #generateCASTIsNil: + #isMemberOf: #generateIsMemberOf: + #isKindOf: #generateIsKindOf: + + #fromStack: #generateFromStack: ). 1 to: pairs size by: 2 do: [:i | - translationDict at: (pairs at: i) put: (pairs at: i + 1)]. + castTranslationDict at: (pairs at: i) put: (pairs at: i + 1)]. ] diff --git a/smalltalksrc/VMMaker/SmartSyntaxPluginTMethod.class.st b/smalltalksrc/VMMaker/SmartSyntaxPluginTMethod.class.st index 68ecd1a622..e6b5b06d0b 100644 --- a/smalltalksrc/VMMaker/SmartSyntaxPluginTMethod.class.st +++ b/smalltalksrc/VMMaker/SmartSyntaxPluginTMethod.class.st @@ -96,7 +96,7 @@ SmartSyntaxPluginTMethod >> fixUpReturnOneStmt: stmt on: sStream [ ["failure returns" sStream nextPut: expr; nextPut: self nullReturnExpr. ^nil]. - (expr isVariable and: ['nil' = expr name]) ifTrue: + (expr isConstant and: [expr value isNil]) ifTrue: ["^ nil -- this is never right unless automatically generated" sStream nextPut: stmt. ^nil]. diff --git a/smalltalksrc/VMMakerCompatibilityForPharo6/PharoVMMaker.class.st b/smalltalksrc/VMMakerCompatibilityForPharo6/PharoVMMaker.class.st index 62c3eedac6..2f1fc09c09 100644 --- a/smalltalksrc/VMMakerCompatibilityForPharo6/PharoVMMaker.class.st +++ b/smalltalksrc/VMMakerCompatibilityForPharo6/PharoVMMaker.class.st @@ -71,9 +71,9 @@ PharoVMMaker >> generate: interpreterClass memoryManager: memoryManager compiler including: #() configuration: VMMakerConfiguration) stopOnErrors: stopOnErrors; - internal: #() external: #(FilePlugin SurfacePlugin); - generateInterpreterFile; - generateCogitFiles; + internal: #() external: #(FilePlugin SurfacePlugin SocketPlugin); + "generateInterpreterFile; + generateCogitFiles;" generateExternalPlugins] valueSupplyingAnswer:true.] ] diff --git a/smalltalksrc/VMMakerCompatibilityForPharo6/RBVariableNode.extension.st b/smalltalksrc/VMMakerCompatibilityForPharo6/RBVariableNode.extension.st index df9003a5f4..4bf461a499 100644 --- a/smalltalksrc/VMMakerCompatibilityForPharo6/RBVariableNode.extension.st +++ b/smalltalksrc/VMMakerCompatibilityForPharo6/RBVariableNode.extension.st @@ -2,9 +2,13 @@ Extension { #name : #RBVariableNode } { #category : #'*VMMakerCompatibilityForPharo6-C translation' } RBVariableNode >> asTranslatorNodeIn: aTMethod [ + "Answer a TParseNode subclass equivalent of me" + name = 'true' ifTrue: [^ TConstantNode value: true]. name = 'false' ifTrue: [^ TConstantNode value: false]. + name = 'nil' ifTrue: [^ TConstantNode value: nil]. + ^ TVariableNode new setName: name ] From 354aa7e79543b9bf60619a879b0eeb337725b3a4 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Fri, 3 Sep 2021 09:52:40 +0200 Subject: [PATCH 04/16] Uncommented the generation of the whole VM --- .../VMMakerCompatibilityForPharo6/PharoVMMaker.class.st | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/smalltalksrc/VMMakerCompatibilityForPharo6/PharoVMMaker.class.st b/smalltalksrc/VMMakerCompatibilityForPharo6/PharoVMMaker.class.st index 2f1fc09c09..0066338e73 100644 --- a/smalltalksrc/VMMakerCompatibilityForPharo6/PharoVMMaker.class.st +++ b/smalltalksrc/VMMakerCompatibilityForPharo6/PharoVMMaker.class.st @@ -72,8 +72,8 @@ PharoVMMaker >> generate: interpreterClass memoryManager: memoryManager compiler configuration: VMMakerConfiguration) stopOnErrors: stopOnErrors; internal: #() external: #(FilePlugin SurfacePlugin SocketPlugin); - "generateInterpreterFile; - generateCogitFiles;" + generateInterpreterFile; + generateCogitFiles; generateExternalPlugins] valueSupplyingAnswer:true.] ] From 585237df78aa46b49af9682ec4bbe2ea2e7d5209 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Wed, 8 Sep 2021 12:39:58 +0200 Subject: [PATCH 05/16] Splitting NetNameResolver --- cmake/vmmaker.cmake | 1 + plugins.cmake | 3 +- plugins/SocketPlugin/include/SocketPlugin.h | 4 +- .../SocketPlugin/include/SocketPluginImpl.h | 110 +++ plugins/SocketPlugin/src/SocketPluginImpl.c | 886 ++---------------- plugins/SocketPlugin/src/nameResolverImpl.c | 579 ++++++++++++ 6 files changed, 748 insertions(+), 835 deletions(-) create mode 100644 plugins/SocketPlugin/include/SocketPluginImpl.h create mode 100644 plugins/SocketPlugin/src/nameResolverImpl.c diff --git a/cmake/vmmaker.cmake b/cmake/vmmaker.cmake index ba703fa1a5..0f19f3be11 100644 --- a/cmake/vmmaker.cmake +++ b/cmake/vmmaker.cmake @@ -45,6 +45,7 @@ endif() set(PLUGIN_GENERATED_FILES ${PHARO_CURRENT_GENERATED}/plugins/src/FilePlugin/FilePlugin.c + ${PHARO_CURRENT_GENERATED}/plugins/src/SocketPlugin/SocketPlugin.c ${PHARO_CURRENT_GENERATED}/plugins/src/SurfacePlugin/SurfacePlugin.c) if(GENERATE_SOURCES) diff --git a/plugins.cmake b/plugins.cmake index d1a006f286..62895b8119 100644 --- a/plugins.cmake +++ b/plugins.cmake @@ -98,10 +98,9 @@ if (${FEATURE_NETWORK}) file(GLOB SocketPlugin_SOURCES ${CMAKE_CURRENT_SOURCE_DIR}/plugins/SocketPlugin/src/*.c - ${PHARO_CURRENT_GENERATED}/plugins/src/SocketPlugin/SocketPlugin.c ) - addLibraryWithRPATH(SocketPlugin ${SocketPlugin_SOURCES}) + addLibraryWithRPATH(SocketPlugin ${SocketPlugin_SOURCES} ${PHARO_CURRENT_GENERATED}/plugins/src/SocketPlugin/SocketPlugin.c) if(WIN) target_link_libraries(SocketPlugin PRIVATE "-lWs2_32") diff --git a/plugins/SocketPlugin/include/SocketPlugin.h b/plugins/SocketPlugin/include/SocketPlugin.h index 28b885b94b..ee5fb29d2d 100644 --- a/plugins/SocketPlugin/include/SocketPlugin.h +++ b/plugins/SocketPlugin/include/SocketPlugin.h @@ -27,9 +27,8 @@ void sqSocketAbortConnection(SocketPtr s); void sqSocketCloseConnection(SocketPtr s); sqInt sqSocketConnectionStatus(SocketPtr s); void sqSocketConnectToPort(SocketPtr s, sqInt addr, sqInt port); -void sqSocketCreateNetTypeSocketTypeRecvBytesSendBytesSemaID(SocketPtr s, sqInt netType, sqInt socketType, sqInt recvBufSize, sqInt sendBufSize, sqInt semaIndex); void sqSocketCreateNetTypeSocketTypeRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(SocketPtr s, sqInt netType, sqInt socketType, sqInt recvBufSize, sqInt sendBufSize, sqInt semaIndex, sqInt readSemaIndex, sqInt writeSemaIndex); -void sqSocketCreateRawProtoTypeRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(SocketPtr s, sqInt domain, sqInt protocol, sqInt recvBufSize, sqInt sendBufSize, sqInt semaIndex, sqInt readSemaIndex, sqInt writeSemaIndex); +void sqSocketCreateRawProtoTypeRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(SocketPtr s, sqInt domain, sqInt protocol, sqInt recvBufSize, sqInt sendBufSize, sqInt semaIndex, sqInt readSemaIndex, sqInt writeSemaIndex); void sqSocketDestroy(SocketPtr s); sqInt sqSocketError(SocketPtr s); void sqSocketListenOnPort(SocketPtr s, sqInt port); @@ -44,7 +43,6 @@ sqInt sqSocketSendDone(SocketPtr s); /* ar 7/16/1999: New primitives for accept(). Note: If accept() calls are not supported simply make the calls fail and the old connection style will be used. */ void sqSocketListenOnPortBacklogSize(SocketPtr s, sqInt port, sqInt backlogSize); void sqSocketListenOnPortBacklogSizeInterface(SocketPtr s, sqInt port, sqInt backlogSize, sqInt addr); -void sqSocketAcceptFromRecvBytesSendBytesSemaID(SocketPtr s, SocketPtr serverSocket, sqInt recvBufSize, sqInt sendBufSize, sqInt semaIndex); void sqSocketAcceptFromRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(SocketPtr s, SocketPtr serverSocket, sqInt recvBufSize, sqInt sendBufSize, sqInt semaIndex, sqInt readSemaIndex, sqInt writeSemaIndex); sqInt sqSocketReceiveUDPDataBufCountaddressportmoreFlag(SocketPtr s, char *buf, sqInt bufSize, sqInt *address, sqInt *port, sqInt *moreFlag); sqInt sqSockettoHostportSendDataBufCount(SocketPtr s, sqInt address, sqInt port, char *buf, sqInt bufSize); diff --git a/plugins/SocketPlugin/include/SocketPluginImpl.h b/plugins/SocketPlugin/include/SocketPluginImpl.h new file mode 100644 index 0000000000..7f186faa45 --- /dev/null +++ b/plugins/SocketPlugin/include/SocketPluginImpl.h @@ -0,0 +1,110 @@ +#pragma once + +#ifdef _WIN32 + + // Need to include winsock2 before windows.h + // Windows.h will import otherwise winsock (1) and create conflicts +#include +#include +#include +#endif //WIN32 + +#include "pharovm/pharo.h" +#include "sq.h" +#include "SocketPlugin.h" +#include "sqaio.h" +#include "pharovm/debug.h" + +#ifdef _WIN32 + +# include + +# include + +typedef unsigned int sa_family_t; + +struct sockaddr_un +{ + sa_family_t sun_family; /* AF_UNIX */ + char sun_path[108]; /* pathname */ +}; + +# define TCP_MAXSEG 536 +# define S_IFSOCK 0xC000 + +# define socklen_t int + +#else + +# include +# include +# include +# include +# include +# include +# include +# include +# include +# include + +# define closesocket(x) close(x) +# define SD_SEND SHUT_WR +# define SD_RECEIVE SHUT_RD + +#endif + +# ifdef NEED_GETHOSTNAME_P + extern int gethostname(); +# endif +# ifdef HAVE_SYS_TIME_H +# include +# else +# include +# endif +# include + +#if !defined(_WIN32) +# include +#endif + +/* Solaris sometimes fails to define this in netdb.h */ +#ifndef MAXHOSTNAMELEN +# define MAXHOSTNAMELEN 256 +#endif + +#ifdef HAVE_SD_DAEMON +# include +#else +# define SD_LISTEN_FDS_START 3 +# define sd_listen_fds(u) 0 +#endif + +#ifndef true +# define true 1 +#endif + +#ifndef false +# define false 0 +#endif + +extern struct VirtualMachine *interpreterProxy; + +struct addressHeader +{ + int sessionID; + int size; +}; + +int getNetSessionID(); + + +#define AddressHeaderSize sizeof(struct addressHeader) + +#define addressHeader(A) ((struct addressHeader *)(A)) +#define socketAddress(A) ((struct sockaddr *)((char *)(A) + AddressHeaderSize)) + +#define addressValid(A, S) (getNetSessionID() && (getNetSessionID() == addressHeader(A)->sessionID) && (addressHeader(A)->size == ((S) - AddressHeaderSize))) +#define addressSize(A) (addressHeader(A)->size) + +void nameResolverInit(sqInt resolverSemaIndex); +void nameResolverFini(); diff --git a/plugins/SocketPlugin/src/SocketPluginImpl.c b/plugins/SocketPlugin/src/SocketPluginImpl.c index 11278b5a6c..99855ff5f4 100644 --- a/plugins/SocketPlugin/src/SocketPluginImpl.c +++ b/plugins/SocketPlugin/src/SocketPluginImpl.c @@ -1,154 +1,4 @@ -/* sqUnixSocket.c -- Unix socket support - * - * Copyright (C) 1996-2007 by Ian Piumarta and other authors/contributors - * listed elsewhere in this file. - * All rights reserved. - * - * This file is part of Unix Squeak. - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * in the Software without restriction, including without limitation the rights - * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell - * copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * The above copyright notice and this permission notice shall be included in - * all copies or substantial portions of the Software. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER - * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, - * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE - * SOFTWARE. - */ - -/* Author: Ian.Piumarta@inria.fr - * - * Support for BSD-style "accept" primitives contributed by: - * Lex Spoon - * - * Raw Socket Support by Andreas Raab, RIP. - * - * Fix to option parsing in sqSocketSetOptions... by Eliot Miranda, 2013/4/12 - * - * Notes: - * Sockets are completely asynchronous, but the resolver is still synchronous. - * - * BUGS: - * Now that the image has real UDP primitives, the TCP/UDP duality in - * many of the connection-oriented functions should be removed and cremated. - */ - -#ifdef _WIN32 - - // Need to include winsock2 before windows.h - // Windows.h will import otherwise winsock (1) and create conflicts -#include -#include -#include -#endif //WIN32 - -#include "pharovm/pharo.h" -#include "sq.h" -#include "SocketPlugin.h" -#include "sqaio.h" -#include "pharovm/debug.h" - -#ifdef ACORN - -# include -# define __time_t -# include -# include "inetlib.h" -# include "socklib.h" -# include "netdb.h" -# include "unixlib.h" -# include "sys/ioctl.h" -# include "sys/errno.h" -# define h_errno errno -# define MAXHOSTNAMELEN 256 -# define socklen_t int -# define strncpy(dst, src, len) copyNCharsFromTo(len, src, dst) - - -#else /* !ACORN */ - -#ifdef _WIN32 - -#include - -#include - -typedef unsigned int sa_family_t; - -struct sockaddr_un -{ - sa_family_t sun_family; /* AF_UNIX */ - char sun_path[108]; /* pathname */ -}; - -#define TCP_MAXSEG 536 -#define S_IFSOCK 0xC000 - -#define socklen_t int - -#else - -# include -# include -# include -# include -# include -# include -# include -# include -# include -#include - -#define closesocket(x) close(x) -#define SD_SEND SHUT_WR -#define SD_RECEIVE SHUT_RD - -#endif - -# ifdef NEED_GETHOSTNAME_P - extern int gethostname(); -# endif -# ifdef HAVE_SYS_TIME_H -# include -# else -# include -# endif -# include - -#if !defined(_WIN32) -# include -#endif -#endif /* !ACORN */ - -/* Solaris sometimes fails to define this in netdb.h */ -#ifndef MAXHOSTNAMELEN -# define MAXHOSTNAMELEN 256 -#endif - -#ifdef HAVE_SD_DAEMON -# include -#else -# define SD_LISTEN_FDS_START 3 -# define sd_listen_fds(u) 0 -#endif - -#ifndef true -# define true 1 -#endif - -#ifndef false -# define false 0 -#endif - +#include "SocketPluginImpl.h" /*** Socket types ***/ @@ -166,32 +16,19 @@ struct sockaddr_un #define ProvidedSeqPacketSocketType (SeqPacketSocketType + ReuseExistingSocket) #define ProvidedReliableDGramSocketType (ReliableDGramSocketType + ReuseExistingSocket) - - -/*** Resolver states ***/ - -#define ResolverUninitialised 0 -#define ResolverSuccess 1 -#define ResolverBusy 2 -#define ResolverError 3 - - /*** TCP Socket states ***/ -#define Invalid -1 -#define Unconnected 0 -#define WaitingForConnection 1 -#define Connected 2 -#define OtherEndClosed 3 -#define ThisEndClosed 4 +#define Invalid -1 +#define Unconnected 0 +#define WaitingForConnection 1 +#define Connected 2 +#define OtherEndClosed 3 +#define ThisEndClosed 4 -#define LINGER_SECS 1 +#define LINGER_SECS 1 volatile static int thisNetSession = 0; -static int one= 1; - -static char localHostName[MAXHOSTNAMELEN]; -static u_long localHostAddress; /* GROSS IPv4 ASSUMPTION! */ +static int one = 1; /* * The ERROR constants are different in Windows and in Unix. @@ -208,7 +45,7 @@ static u_long localHostAddress; /* GROSS IPv4 ASSUMPTION! */ union sockaddr_any { - struct sockaddr sa; + struct sockaddr sa; struct sockaddr_un saun; struct sockaddr_in sin; struct sockaddr_in6 sin6; @@ -231,8 +68,8 @@ typedef struct privateSocketStruct int socketType; } privateSocketStruct; -#define CONN_NOTIFY (1<<0) -#define READ_NOTIFY (1<<1) +#define CONN_NOTIFY (1<<0) +#define READ_NOTIFY (1<<1) #define WRITE_NOTIFY (1<<2) #define PING(S,EVT) \ @@ -261,16 +98,8 @@ typedef struct privateSocketStruct #define SOCKETPEERSIZE(S) (PSP(S)->peerSize) -/*** Resolver state ***/ - -static char lastName[MAXHOSTNAMELEN+1]; -static int lastAddr= 0; -static int lastError= 0; -static int resolverSema= 0; - /*** Variables ***/ -extern struct VirtualMachine *interpreterProxy; #if !defined(SQUEAK_BUILTIN_PLUGIN) # define success(bool) interpreterProxy->success(bool) #endif @@ -344,64 +173,11 @@ static void setLinger(int fd, int flag) setsockopt(fd, SOL_SOCKET, SO_LINGER, (char *)&linger, sizeof(linger)); } -/* answer the hostname for the given IP address */ - -static const char *addrToName(int netAddress) -{ - u_long nAddr; - struct hostent *he; - - lastError= 0; /* for the resolver */ - nAddr= htonl(netAddress); - if ((he= gethostbyaddr((char *)&nAddr, sizeof(nAddr), AF_INET))) - return he->h_name; - lastError= h_errno; /* ditto */ - return ""; -} - -/* answer the IP address for the given hostname */ - -static int nameToAddr(char *hostName) -{ - struct addrinfo* result; - struct addrinfo* anAddressInfo; - int error; - int address = 0; - struct sockaddr_in* addr; - - /* resolve the domain name into a list of addresses */ - error = getaddrinfo(hostName, NULL, NULL, &result); - if (error != 0) { - lastError = error; - return 0; - } - - anAddressInfo = result; - - while(anAddressInfo && address == 0){ - - if(anAddressInfo->ai_family == AF_INET){ - addr = (struct sockaddr_in *)anAddressInfo->ai_addr; -#ifdef _WIN32 - address = ntohl(addr->sin_addr.S_un.S_addr); -#else - address = ntohl(addr->sin_addr.s_addr); -#endif - } - - anAddressInfo = anAddressInfo->ai_next; - } - - freeaddrinfo(result); - - return address; -} - /* answer whether the given socket is valid in this net session */ static int socketValid(SocketPtr s) { - if (s && s->privateSocketPtr && thisNetSession && (s->sessionID == thisNetSession)) + if (s && s->privateSocketPtr && getNetSessionID() && (s->sessionID == getNetSessionID())) return true; success(false); return false; @@ -633,21 +409,24 @@ static void closeHandler(int fd, void *data, int flags) } -/*** Squeak network functions ***/ - +int getNetSessionID(){ + return thisNetSession; +} /* start a new network session */ sqInt sqNetworkInit(sqInt resolverSemaIndex) { - if (0 != thisNetSession) + if (0 != getNetSessionID()) return 0; /* already initialised */ - gethostname(localHostName, MAXHOSTNAMELEN); - localHostAddress= nameToAddr(localHostName); - thisNetSession= clock() + time(0); - if (0 == thisNetSession) - thisNetSession= 1; /* 0 => uninitialised */ - resolverSema= resolverSemaIndex; + + nameResolverInit(resolverSemaIndex); + + thisNetSession = clock() + time(0); + + if (0 == getNetSessionID()) + thisNetSession = 1; /* 0 => uninitialised */ + return 0; } @@ -656,23 +435,14 @@ sqInt sqNetworkInit(sqInt resolverSemaIndex) void sqNetworkShutdown(void) { - thisNetSession= 0; - resolverSema= 0; - aioFini(); + thisNetSession= 0; + nameResolverFini(); + aioFini(); } - - /*** Squeak Generic Socket Functions ***/ -/* create a new socket */ - -void sqSocketCreateNetTypeSocketTypeRecvBytesSendBytesSemaID(SocketPtr s, sqInt domain, sqInt socketType, sqInt recvBufSize, sqInt sendBufSize, sqInt semaIndex) -{ - sqSocketCreateNetTypeSocketTypeRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(s, domain, socketType,recvBufSize, sendBufSize, semaIndex, semaIndex, semaIndex); -} - void sqSocketCreateNetTypeSocketTypeRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(SocketPtr s, sqInt domain, sqInt socketType, sqInt recvBufSize, sqInt sendBufSize, sqInt semaIndex, sqInt readSemaIndex, sqInt writeSemaIndex) { int newSocket= -1; @@ -749,7 +519,7 @@ void sqSocketCreateNetTypeSocketTypeRecvBytesSendBytesSemaIDReadSemaIDWriteSemaI pss->peer.sin.sin_port= 0; pss->peer.sin.sin_addr.s_addr= INADDR_ANY; /* Squeak socket */ - s->sessionID= thisNetSession; + s->sessionID= getNetSessionID(); s->socketType= socketType; s->privateSocketPtr= pss; logTrace("create(%d) -> %lx\n", SOCKET(s), (unsigned long)PSP(s)); @@ -797,7 +567,7 @@ void sqSocketCreateRawProtoTypeRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(Soc pss->peer.sin.sin_port= 0; pss->peer.sin.sin_addr.s_addr= INADDR_ANY; /* Squeak socket */ - s->sessionID= thisNetSession; + s->sessionID= getNetSessionID(); s->socketType= RAWSocketType; s->privateSocketPtr= pss; logTrace("create(%d) -> %lx\n", SOCKET(s), (unsigned long)PSP(s)); @@ -944,13 +714,6 @@ void sqSocketConnectToPort(SocketPtr s, sqInt addr, sqInt port) } } - -void sqSocketAcceptFromRecvBytesSendBytesSemaID(SocketPtr s, SocketPtr serverSocket, sqInt recvBufSize, sqInt sendBufSize, sqInt semaIndex) -{ - sqSocketAcceptFromRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(s, serverSocket, recvBufSize, sendBufSize, semaIndex, semaIndex, semaIndex); -} - - void sqSocketAcceptFromRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(SocketPtr s, SocketPtr serverSocket, sqInt recvBufSize, sqInt sendBufSize, sqInt semaIndex, sqInt readSemaIndex, sqInt writeSemaIndex) { /* The image has already called waitForConnection, so there is no @@ -991,7 +754,7 @@ void sqSocketAcceptFromRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(SocketPtr s PSP(serverSocket)->acceptedSock= -1; SOCKETSTATE(serverSocket)= WaitingForConnection; aioHandle(SOCKET(serverSocket), acceptHandler, AIO_RX); - s->sessionID= thisNetSession; + s->sessionID= getNetSessionID(); pss->connSema= semaIndex; pss->readSema= readSemaIndex; pss->writeSema= writeSemaIndex; @@ -1629,175 +1392,9 @@ void sqSocketSetReusable(SocketPtr s) } } -/*** Resolver functions ***/ - - -/* Note: the Mac and Win32 implementations implement asynchronous lookups - * in the DNS. I can't think of an easy way to do this in Unix without - * going totally ott with threads or somesuch. If anyone knows differently, - * please tell me about it. - Ian - */ - - -/*** irrelevancies ***/ - -void sqResolverAbort(void) {} - -void sqResolverStartAddrLookup(sqInt address) -{ - const char *res; - res= addrToName(address); - strncpy(lastName, res, MAXHOSTNAMELEN); - logTrace( "startAddrLookup %s\n", lastName); -} - - -sqInt sqResolverStatus(void) -{ - if (!thisNetSession) - return ResolverUninitialised; - if (lastError != 0) - return ResolverError; - return ResolverSuccess; -} - -/*** trivialities ***/ - -sqInt sqResolverAddrLookupResultSize(void) { return strlen(lastName); } -sqInt sqResolverError(void) { return lastError; } -sqInt sqResolverLocalAddress(void) { - -#ifndef _WIN32 - - /* - * TODO: Check all this code, because is does not work if you have more than one network interface. - */ - - struct ifaddrs *ifaddr, *ifa; - int s; - char host[NI_MAXHOST]; - sqInt localAddr = 0; - - if (getifaddrs(&ifaddr) == -1) { - success(false); - return 0; - } - - - for (ifa = ifaddr; ifa != NULL; ifa = ifa->ifa_next) - { - if (ifa->ifa_addr == NULL) - continue; - - s=getnameinfo(ifa->ifa_addr,sizeof(struct sockaddr_in),host, NI_MAXHOST, NULL, 0, NI_NUMERICHOST); - - if(((strcmp(ifa->ifa_name,"eth0")==0)||(strcmp(ifa->ifa_name,"wlan0")==0))&&(ifa->ifa_addr->sa_family==AF_INET)) - { - if (s != 0) - { - success(false); - return 0; - } - logTrace( "\tInterface : <%s>\n",ifa->ifa_name ); - logTrace( "\t IP : <%s>\n", inet_ntoa(((struct sockaddr_in *)(ifa->ifa_addr))->sin_addr)); - if(localAddr == 0) { /* take the first plausible answer */ - localAddr = ((struct sockaddr_in *)(ifa->ifa_addr))->sin_addr.s_addr; - } - - } - } - - freeifaddrs(ifaddr); - return ntohl(localAddr); -#else - - static char localHostName[MAXHOSTNAMELEN]; - static u_long localHostAddress; - - sqInt address; - - gethostname(localHostName,MAXHOSTNAMELEN); - - return nameToAddr(localHostName); - -#endif -} - -sqInt sqResolverNameLookupResult(void) { - if(lastError != 0) - success(false); - - return lastAddr; } - -void -sqResolverAddrLookupResult(char *nameForAddress, sqInt nameSize) { - memcpy(nameForAddress, lastName, nameSize); -} - -/*** name resolution ***/ - -void -sqResolverStartNameLookup(char *hostName, sqInt nameSize) { - int len= (nameSize < MAXHOSTNAMELEN) ? nameSize : MAXHOSTNAMELEN; - memcpy(lastName, hostName, len); - lastName[len]= lastError= 0; - logTrace( "name lookup %s\n", lastName); - lastAddr= nameToAddr(lastName); - /* we're done before we even started */ - interpreterProxy->signalSemaphoreWithIndex(resolverSema); -} - - -/* ikp 2007-06-07: Generalised primitives for IPv6, &c. */ - -/* flags */ - -#define SQ_SOCKET_NUMERIC (1<<0) -#define SQ_SOCKET_PASSIVE (1<<1) - -/* family */ - -#define SQ_SOCKET_FAMILY_UNSPECIFIED 0 -#define SQ_SOCKET_FAMILY_LOCAL 1 -#define SQ_SOCKET_FAMILY_INET4 2 -#define SQ_SOCKET_FAMILY_INET6 3 -#define SQ_SOCKET_FAMILY_MAX 4 - -/* type */ - -#define SQ_SOCKET_TYPE_UNSPECIFIED 0 -#define SQ_SOCKET_TYPE_STREAM 1 -#define SQ_SOCKET_TYPE_DGRAM 2 -#define SQ_SOCKET_TYPE_MAX 3 - -/* protocol */ - -#define SQ_SOCKET_PROTOCOL_UNSPECIFIED 0 -#define SQ_SOCKET_PROTOCOL_TCP 1 -#define SQ_SOCKET_PROTOCOL_UDP 2 -#define SQ_SOCKET_PROTOCOL_MAX 3 - -void sqResolverGetAddressInfoHostSizeServiceSizeFlagsFamilyTypeProtocol(char *hostName, sqInt hostSize, char *servName, sqInt servSize, - sqInt flags, sqInt family, sqInt type, sqInt protocol); -sqInt sqResolverGetAddressInfoSize(void); -void sqResolverGetAddressInfoResultSize(char *addr, sqInt addrSize); -sqInt sqResolverGetAddressInfoFamily(void); -sqInt sqResolverGetAddressInfoType(void); -sqInt sqResolverGetAddressInfoProtocol(void); -sqInt sqResolverGetAddressInfoNext(void); - sqInt sqSocketAddressSizeGetPort(char *addr, sqInt addrSize); void sqSocketAddressSizeSetPort(char *addr, sqInt addrSize, sqInt port); -void sqResolverGetNameInfoSizeFlags(char *addr, sqInt addrSize, sqInt flags); -sqInt sqResolverGetNameInfoHostSize(void); -void sqResolverGetNameInfoHostResultSize(char *name, sqInt nameSize); -sqInt sqResolverGetNameInfoServiceSize(void); -void sqResolverGetNameInfoServiceResultSize(char *name, sqInt nameSize); - -sqInt sqResolverHostNameSize(void); -void sqResolverHostNameResultSize(char *name, sqInt nameSize); - void sqSocketBindToAddressSize(SocketPtr s, char *addr, sqInt addrSize); void sqSocketListenBacklog(SocketPtr s, sqInt backlogSize); void sqSocketConnectToAddressSize(SocketPtr s, char *addr, sqInt addrSize); @@ -1811,246 +1408,6 @@ sqInt sqSocketSendUDPToSizeDataBufCount(SocketPtr s, char *addr, sqInt addrSize, sqInt sqSocketReceiveUDPDataBufCount(SocketPtr s, char *buf, sqInt bufSize); -/* ---- address and service lookup ---- */ - - -static struct addrinfo *addrList= 0; -static struct addrinfo *addrInfo= 0; -static struct addrinfo *localInfo= 0; - - -void sqResolverGetAddressInfoHostSizeServiceSizeFlagsFamilyTypeProtocol(char *hostName, sqInt hostSize, char *servName, sqInt servSize, - sqInt flags, sqInt family, sqInt type, sqInt protocol) -{ - char host[MAXHOSTNAMELEN+1], serv[MAXHOSTNAMELEN+1]; - struct addrinfo request; - int gaiError= 0; - - logTrace( "GetAddressInfo %ld %ld %ld %ld %ld %ld\n", hostSize, servSize, flags, family, type, protocol); - - if (addrList) - { - freeaddrinfo(addrList); - addrList= addrInfo= 0; - } - - if (localInfo) - { - free(localInfo->ai_addr); - free(localInfo); - localInfo= addrInfo= 0; - } - - if ((!thisNetSession) - || (hostSize < 0) || (hostSize > MAXHOSTNAMELEN) - || (servSize < 0) || (servSize > MAXHOSTNAMELEN) - || (family < 0) || (family >= SQ_SOCKET_FAMILY_MAX) - || (type < 0) || (type >= SQ_SOCKET_TYPE_MAX) - || (protocol < 0) || (protocol >= SQ_SOCKET_PROTOCOL_MAX)) - goto fail; - - if (hostSize) - memcpy(host, hostName, hostSize); - host[hostSize]= '\0'; - - if (servSize) - memcpy(serv, servName, servSize); - serv[servSize]= '\0'; - - logTrace( " -> GetAddressInfo %s %s\n", host, serv); - - if (servSize && (family == SQ_SOCKET_FAMILY_LOCAL) && (servSize < sizeof(((struct sockaddr_un *)0)->sun_path)) && !(flags & SQ_SOCKET_NUMERIC)) - { - struct stat st; - if ((0 == stat(servName, &st)) && (st.st_mode & S_IFSOCK)) - { - struct sockaddr_un *saun= calloc(1, sizeof(struct sockaddr_un)); - localInfo= (struct addrinfo *)calloc(1, sizeof(struct addrinfo)); - localInfo->ai_family= AF_UNIX; - localInfo->ai_socktype= SOCK_STREAM; - localInfo->ai_addrlen= sizeof(struct sockaddr_un); - localInfo->ai_addr= (struct sockaddr *)saun; - /*saun->sun_len= sizeof(struct sockaddr_un);*/ - saun->sun_family= AF_UNIX; - memcpy(saun->sun_path, servName, servSize); - saun->sun_path[servSize]= '\0'; - addrInfo= localInfo; - interpreterProxy->signalSemaphoreWithIndex(resolverSema); - return; - } - } - - memset(&request, 0, sizeof(request)); - - if (flags & SQ_SOCKET_NUMERIC) request.ai_flags |= AI_NUMERICHOST; - if (flags & SQ_SOCKET_PASSIVE) request.ai_flags |= AI_PASSIVE; - - switch (family) - { - case SQ_SOCKET_FAMILY_LOCAL: request.ai_family= AF_UNIX; break; - case SQ_SOCKET_FAMILY_INET4: request.ai_family= AF_INET; break; - case SQ_SOCKET_FAMILY_INET6: request.ai_family= AF_INET6; break; - } - - switch (type) - { - case SQ_SOCKET_TYPE_STREAM: request.ai_socktype= SOCK_STREAM; break; - case SQ_SOCKET_TYPE_DGRAM: request.ai_socktype= SOCK_DGRAM; break; - } - - switch (protocol) - { - case SQ_SOCKET_PROTOCOL_TCP: request.ai_protocol= IPPROTO_TCP; break; - case SQ_SOCKET_PROTOCOL_UDP: request.ai_protocol= IPPROTO_UDP; break; - } - - gaiError= getaddrinfo(hostSize ? host : 0, servSize ? serv : 0, &request, &addrList); - - if (gaiError) - { - /* Linux gives you either with correct NI_* bit definitions and no EAI_* definitions at all - or with incorrect NI_* bit definitions and the EAI_* definitions we need. - We cannot distinguish between impossible constraints and genuine lookup failure, so err conservatively. */ -# if defined(EAI_BADHINTS) - if (EAI_BADHINTS != gaiError) - { - logTrace("getaddrinfo: %s\n", gai_strerror(gaiError)); - lastError= gaiError; - goto fail; - } -# else - logTrace("getaddrinfo: %s\n", gai_strerror(gaiError)); -# endif - addrList= 0; /* succeed with zero results for impossible constraints */ - } - - addrInfo= addrList; - interpreterProxy->signalSemaphoreWithIndex(resolverSema); - return; - - fail: - success(false); - return; -} - - -struct addressHeader -{ - int sessionID; - int size; -}; - -#define AddressHeaderSize sizeof(struct addressHeader) - -#define addressHeader(A) ((struct addressHeader *)(A)) -#define socketAddress(A) ((struct sockaddr *)((char *)(A) + AddressHeaderSize)) - -#define addressValid(A, S) (thisNetSession && (thisNetSession == addressHeader(A)->sessionID) && (addressHeader(A)->size == ((S) - AddressHeaderSize))) -#define addressSize(A) (addressHeader(A)->size) - - -#if 0 -static void dumpAddr(struct sockaddr *addr, int addrSize) -{ - int i; - for (i= 0; i < addrSize; ++i) - logTrace("%02x ", ((unsigned char *)addr)[i]); - logTrace(" "); - switch (addr->sa_family) - { - case AF_UNIX: logTrace("local\n"); break; - case AF_INET: logTrace("inet\n"); break; - case AF_INET6: logTrace("inet6\n"); break; - default: logTrace("?\n"); break; - } -} -#endif - -sqInt sqResolverGetAddressInfoSize(void) -{ - if (!addrInfo) - return -1; - return AddressHeaderSize + addrInfo->ai_addrlen; -} - - -void sqResolverGetAddressInfoResultSize(char *addr, sqInt addrSize) -{ - if ((!addrInfo) || (addrSize < (AddressHeaderSize + addrInfo->ai_addrlen))) - { - success(false); - return; - } - - addressHeader(addr)->sessionID= thisNetSession; - - addressHeader(addr)->size= addrInfo->ai_addrlen; - memcpy(socketAddress(addr), addrInfo->ai_addr, addrInfo->ai_addrlen); - /*dumpAddr(socketAddress(addr), addrSize - AddressHeaderSize);*/ -} - - -sqInt sqResolverGetAddressInfoFamily(void) -{ - if (!addrInfo) - { - success(false); - return 0; - } - - switch (addrInfo->ai_family) - { - case AF_UNIX: return SQ_SOCKET_FAMILY_LOCAL; - case AF_INET: return SQ_SOCKET_FAMILY_INET4; - case AF_INET6: return SQ_SOCKET_FAMILY_INET6; - } - - return SQ_SOCKET_FAMILY_UNSPECIFIED; -} - - -sqInt sqResolverGetAddressInfoType(void) -{ - if (!addrInfo) - { - success(false); - return 0; - } - - switch (addrInfo->ai_socktype) - { - case SOCK_STREAM: return SQ_SOCKET_TYPE_STREAM; - case SOCK_DGRAM: return SQ_SOCKET_TYPE_DGRAM; - } - - return SQ_SOCKET_TYPE_UNSPECIFIED; -} - - -sqInt sqResolverGetAddressInfoProtocol(void) -{ - if (!addrInfo) - { - success(false); - return 0; - } - - switch (addrInfo->ai_protocol) - { - case IPPROTO_TCP: return SQ_SOCKET_PROTOCOL_TCP; - case IPPROTO_UDP: return SQ_SOCKET_PROTOCOL_UDP; - } - - return SQ_SOCKET_PROTOCOL_UNSPECIFIED; -} - - -sqInt sqResolverGetAddressInfoNext(void) -{ - return (addrInfo && (addrInfo= addrInfo->ai_next)) ? true : false; -} - - /* ---- address manipulation ---- */ @@ -2081,139 +1438,6 @@ void sqSocketAddressSizeSetPort(char *addr, sqInt addrSize, sqInt port) } -/* ---- host name lookup ---- */ - - -static char hostNameInfo[MAXHOSTNAMELEN+1]; -static char servNameInfo[MAXHOSTNAMELEN+1]; - -static int nameInfoValid= 0; - - -void sqResolverGetNameInfoSizeFlags(char *addr, sqInt addrSize, sqInt flags) -{ - int niFlags= 0; - int gaiError= 0; - - logTrace( "GetNameInfoSizeFlags %p %ld %ld\n", addr, addrSize, flags); - - nameInfoValid= 0; - - if (!addressValid(addr, addrSize)) - goto fail; - - niFlags |= NI_NOFQDN; - - if (flags & SQ_SOCKET_NUMERIC) niFlags |= (NI_NUMERICHOST | NI_NUMERICSERV); - - /*dumpAddr(socketAddress(addr), addrSize - AddressHeaderSize); logTrace("%02x\n", niFlags);*/ - - gaiError= getnameinfo(socketAddress(addr), addrSize - AddressHeaderSize, - hostNameInfo, sizeof(hostNameInfo), - servNameInfo, sizeof(servNameInfo), - niFlags); - - if (gaiError) - { - logTrace("getnameinfo: %s\n", gai_strerror(gaiError)); - lastError= gaiError; - goto fail; - } - - nameInfoValid= 1; - interpreterProxy->signalSemaphoreWithIndex(resolverSema); - return; - - fail: - success(false); -} - - -sqInt sqResolverGetNameInfoHostSize(void) -{ - if (!nameInfoValid) - { - success(false); - return 0; - } - return strlen(hostNameInfo); -} - - -void sqResolverGetNameInfoHostResultSize(char *name, sqInt nameSize) -{ - int len; - - if (!nameInfoValid) - goto fail; - - len= strlen(hostNameInfo); - if (nameSize < len) - goto fail; - - memcpy(name, hostNameInfo, len); - return; - - fail: - success(false); -} - - -sqInt sqResolverGetNameInfoServiceSize(void) -{ - if (!nameInfoValid) - { - success(false); - return 0; - } - return strlen(servNameInfo); -} - - -void sqResolverGetNameInfoServiceResultSize(char *name, sqInt nameSize) -{ - int len; - - if (!nameInfoValid) - goto fail; - - len= strlen(servNameInfo); - if (nameSize < len) - goto fail; - - memcpy(name, servNameInfo, len); - return; - - fail: - success(false); -} - - -sqInt sqResolverHostNameSize(void) -{ - char buf[MAXHOSTNAMELEN+1]; - if (gethostname(buf, sizeof(buf))) - { - success(false); - return 0; - } - return strlen(buf); -} - - -void sqResolverHostNameResultSize(char *name, sqInt nameSize) -{ - char buf[MAXHOSTNAMELEN+1]; - int len; - if (gethostname(buf, sizeof(buf)) || (nameSize < (len= strlen(buf)))) - { - success(false); - return; - } - memcpy(name, buf, len); -} - - /* ---- circuit setup ---- */ @@ -2352,7 +1576,7 @@ void sqSocketLocalAddressResultSize(SocketPtr s, char *addr, int addrSize) if (addrSize != (AddressHeaderSize + saddrSize)) goto fail; - addressHeader(addr)->sessionID= thisNetSession; + addressHeader(addr)->sessionID= getNetSessionID(); addressHeader(addr)->size= saddrSize; memcpy(socketAddress(addr), &saddr.sa, saddrSize); @@ -2401,7 +1625,7 @@ void sqSocketRemoteAddressResultSize(SocketPtr s, char *addr, int addrSize) return; } - addressHeader(addr)->sessionID= thisNetSession; + addressHeader(addr)->sessionID= getNetSessionID(); addressHeader(addr)->size= SOCKETPEERSIZE(s); memcpy(socketAddress(addr), &SOCKETPEER(s), SOCKETPEERSIZE(s)); @@ -2435,31 +1659,33 @@ sqInt sqSocketSendUDPToSizeDataBufCount(SocketPtr s, char *addr, sqInt addrSize, } -sqInt sqSocketReceiveUDPDataBufCount(SocketPtr s, char *buf, sqInt bufSize) -{ - logTrace("recvFrom(%d)\n", SOCKET(s)); - if (socketValid(s) && (TCPSocketType != s->socketType)){ +sqInt sqSocketReceiveUDPDataBufCount(SocketPtr s, char *buf, sqInt bufSize) { + int lastError; - /* --- UDP/RAW --- */ + logTrace("recvFrom(%d)\n", SOCKET(s)); + if (socketValid(s) && (TCPSocketType != s->socketType)) { - socklen_t saddrSize= sizeof(SOCKETPEER(s)); + /* --- UDP/RAW --- */ - int nread= recvfrom(SOCKET(s), buf, bufSize, 0, &SOCKETPEER(s).sa, &saddrSize); + socklen_t saddrSize = sizeof(SOCKETPEER(s)); - lastError = getLastSocketError(); + int nread = recvfrom(SOCKET(s), buf, bufSize, 0, &SOCKETPEER(s).sa, + &saddrSize); - if (nread >= 0) { - SOCKETPEERSIZE(s)= saddrSize; - return nread; - } + lastError = getLastSocketError(); - SOCKETPEERSIZE(s)= 0; - if (lastError == ERROR_WOULD_BLOCK) /* asynchronous read in progress */ - return 0; + if (nread >= 0) { + SOCKETPEERSIZE(s) = saddrSize; + return nread; + } - SOCKETERROR(s)= lastError; - logTrace("receiveData(%d)= %da\n", SOCKET(s), 0); - } - success(false); - return 0; -} \ No newline at end of file + SOCKETPEERSIZE(s) = 0; + if (lastError == ERROR_WOULD_BLOCK) /* asynchronous read in progress */ + return 0; + + SOCKETERROR(s) = lastError; + logTrace("receiveData(%d)= %da\n", SOCKET(s), 0); + } + success(false); + return 0; +} diff --git a/plugins/SocketPlugin/src/nameResolverImpl.c b/plugins/SocketPlugin/src/nameResolverImpl.c new file mode 100644 index 0000000000..2bd6169467 --- /dev/null +++ b/plugins/SocketPlugin/src/nameResolverImpl.c @@ -0,0 +1,579 @@ +#include "SocketPluginImpl.h" + +/*** Resolver states ***/ + +#define ResolverUninitialised 0 +#define ResolverSuccess 1 +#define ResolverBusy 2 +#define ResolverError 3 + + +/*** Resolver state ***/ + +static char lastName[MAXHOSTNAMELEN+1]; +static int lastAddr= 0; +static int lastError= 0; +static int resolverSema= 0; + +static char localHostName[MAXHOSTNAMELEN]; +static u_long localHostAddress; /* GROSS IPv4 ASSUMPTION! */ + +static char hostNameInfo[MAXHOSTNAMELEN+1]; +static char servNameInfo[MAXHOSTNAMELEN+1]; + +static int nameInfoValid= 0; + + +static struct addrinfo *addrList= 0; +static struct addrinfo *addrInfo= 0; +static struct addrinfo *localInfo= 0; + +/* flags */ + +#define SQ_SOCKET_NUMERIC (1<<0) +#define SQ_SOCKET_PASSIVE (1<<1) + +/* family */ + +#define SQ_SOCKET_FAMILY_UNSPECIFIED 0 +#define SQ_SOCKET_FAMILY_LOCAL 1 +#define SQ_SOCKET_FAMILY_INET4 2 +#define SQ_SOCKET_FAMILY_INET6 3 +#define SQ_SOCKET_FAMILY_MAX 4 + +/* type */ + +#define SQ_SOCKET_TYPE_UNSPECIFIED 0 +#define SQ_SOCKET_TYPE_STREAM 1 +#define SQ_SOCKET_TYPE_DGRAM 2 +#define SQ_SOCKET_TYPE_MAX 3 + +/* protocol */ + +#define SQ_SOCKET_PROTOCOL_UNSPECIFIED 0 +#define SQ_SOCKET_PROTOCOL_TCP 1 +#define SQ_SOCKET_PROTOCOL_UDP 2 +#define SQ_SOCKET_PROTOCOL_MAX 3 + +/* answer the hostname for the given IP address */ + +static const char *addrToName(int netAddress) +{ + u_long nAddr; + struct hostent *he; + + lastError= 0; /* for the resolver */ + nAddr= htonl(netAddress); + if ((he= gethostbyaddr((char *)&nAddr, sizeof(nAddr), AF_INET))) + return he->h_name; + lastError= h_errno; /* ditto */ + return ""; +} + +/* answer the IP address for the given hostname */ + +static int nameToAddr(char *hostName) +{ + struct addrinfo* result; + struct addrinfo* anAddressInfo; + int error; + int address = 0; + struct sockaddr_in* addr; + + + /* resolve the domain name into a list of addresses */ + error = getaddrinfo(hostName, NULL, NULL, &result); + if (error != 0) { + lastError = error; + return 0; + } + + anAddressInfo = result; + + while(anAddressInfo && address == 0){ + + if(anAddressInfo->ai_family == AF_INET){ + addr = (struct sockaddr_in *)anAddressInfo->ai_addr; +#ifdef _WIN32 + address = ntohl(addr->sin_addr.S_un.S_addr); +#else + address = ntohl(addr->sin_addr.s_addr); +#endif + } + + anAddressInfo = anAddressInfo->ai_next; + } + + freeaddrinfo(result); + + return address; +} + +/*** Resolver functions ***/ + + +/* Note: the Mac and Win32 implementations implement asynchronous lookups + * in the DNS. I can't think of an easy way to do this in Unix without + * going totally ott with threads or somesuch. If anyone knows differently, + * please tell me about it. - Ian + */ + + +/*** irrelevancies ***/ + +void sqResolverAbort(void) {} + +void sqResolverStartAddrLookup(sqInt address) +{ + const char *res; + res= addrToName(address); + strncpy(lastName, res, MAXHOSTNAMELEN); + logTrace( "startAddrLookup %s\n", lastName); +} + + +sqInt sqResolverStatus(void) +{ + if (!getNetSessionID()) + return ResolverUninitialised; + if (lastError != 0) + return ResolverError; + return ResolverSuccess; +} + +/*** trivialities ***/ + +sqInt sqResolverAddrLookupResultSize(void) { return strlen(lastName); } +sqInt sqResolverError(void) { return lastError; } +sqInt sqResolverLocalAddress(void) { + +#ifndef _WIN32 + + /* + * TODO: Check all this code, because is does not work if you have more than one network interface. + */ + + struct ifaddrs *ifaddr, *ifa; + int s; + char host[NI_MAXHOST]; + sqInt localAddr = 0; + + if (getifaddrs(&ifaddr) == -1) { + success(false); + return 0; + } + + + for (ifa = ifaddr; ifa != NULL; ifa = ifa->ifa_next) + { + if (ifa->ifa_addr == NULL) + continue; + + s=getnameinfo(ifa->ifa_addr,sizeof(struct sockaddr_in),host, NI_MAXHOST, NULL, 0, NI_NUMERICHOST); + + if(((strcmp(ifa->ifa_name,"eth0")==0)||(strcmp(ifa->ifa_name,"wlan0")==0))&&(ifa->ifa_addr->sa_family==AF_INET)) + { + if (s != 0) + { + success(false); + return 0; + } + logTrace( "\tInterface : <%s>\n",ifa->ifa_name ); + logTrace( "\t IP : <%s>\n", inet_ntoa(((struct sockaddr_in *)(ifa->ifa_addr))->sin_addr)); + if(localAddr == 0) { /* take the first plausible answer */ + localAddr = ((struct sockaddr_in *)(ifa->ifa_addr))->sin_addr.s_addr; + } + + } + } + + freeifaddrs(ifaddr); + return ntohl(localAddr); +#else + + static char localHostName[MAXHOSTNAMELEN]; + static u_long localHostAddress; + + sqInt address; + + gethostname(localHostName,MAXHOSTNAMELEN); + + return nameToAddr(localHostName); + +#endif +} + +sqInt sqResolverNameLookupResult(void) { + if(lastError != 0) + success(false); + + return lastAddr; } + +void +sqResolverAddrLookupResult(char *nameForAddress, sqInt nameSize) { + memcpy(nameForAddress, lastName, nameSize); +} + +/*** name resolution ***/ + +void +sqResolverStartNameLookup(char *hostName, sqInt nameSize) { + int len= (nameSize < MAXHOSTNAMELEN) ? nameSize : MAXHOSTNAMELEN; + memcpy(lastName, hostName, len); + lastName[len]= lastError= 0; + logTrace( "name lookup %s\n", lastName); + lastAddr= nameToAddr(lastName); + /* we're done before we even started */ + interpreterProxy->signalSemaphoreWithIndex(resolverSema); +} + +#if 0 +static void dumpAddr(struct sockaddr *addr, int addrSize) +{ + int i; + for (i= 0; i < addrSize; ++i) + logTrace("%02x ", ((unsigned char *)addr)[i]); + logTrace(" "); + switch (addr->sa_family) + { + case AF_UNIX: logTrace("local\n"); break; + case AF_INET: logTrace("inet\n"); break; + case AF_INET6: logTrace("inet6\n"); break; + default: logTrace("?\n"); break; + } +} +#endif + +sqInt sqResolverGetAddressInfoSize(void) +{ + if (!addrInfo) + return -1; + return AddressHeaderSize + addrInfo->ai_addrlen; +} + + +void sqResolverGetAddressInfoResultSize(char *addr, sqInt addrSize) +{ + if ((!addrInfo) || (addrSize < (AddressHeaderSize + addrInfo->ai_addrlen))) + { + success(false); + return; + } + + addressHeader(addr)->sessionID= getNetSessionID(); + + addressHeader(addr)->size= addrInfo->ai_addrlen; + memcpy(socketAddress(addr), addrInfo->ai_addr, addrInfo->ai_addrlen); + /*dumpAddr(socketAddress(addr), addrSize - AddressHeaderSize);*/ +} + +/* ---- address and service lookup ---- */ + + +void sqResolverGetAddressInfoHostSizeServiceSizeFlagsFamilyTypeProtocol(char *hostName, sqInt hostSize, char *servName, sqInt servSize, + sqInt flags, sqInt family, sqInt type, sqInt protocol) +{ + char host[MAXHOSTNAMELEN+1], serv[MAXHOSTNAMELEN+1]; + struct addrinfo request; + int gaiError= 0; + + logTrace( "GetAddressInfo %ld %ld %ld %ld %ld %ld\n", hostSize, servSize, flags, family, type, protocol); + + if (addrList) + { + freeaddrinfo(addrList); + addrList= addrInfo= 0; + } + + if (localInfo) + { + free(localInfo->ai_addr); + free(localInfo); + localInfo= addrInfo= 0; + } + + if ((!getNetSessionID()) + || (hostSize < 0) || (hostSize > MAXHOSTNAMELEN) + || (servSize < 0) || (servSize > MAXHOSTNAMELEN) + || (family < 0) || (family >= SQ_SOCKET_FAMILY_MAX) + || (type < 0) || (type >= SQ_SOCKET_TYPE_MAX) + || (protocol < 0) || (protocol >= SQ_SOCKET_PROTOCOL_MAX)) + goto fail; + + if (hostSize) + memcpy(host, hostName, hostSize); + host[hostSize]= '\0'; + + if (servSize) + memcpy(serv, servName, servSize); + serv[servSize]= '\0'; + + logTrace( " -> GetAddressInfo %s %s\n", host, serv); + + if (servSize && (family == SQ_SOCKET_FAMILY_LOCAL) && (servSize < sizeof(((struct sockaddr_un *)0)->sun_path)) && !(flags & SQ_SOCKET_NUMERIC)) + { + struct stat st; + if ((0 == stat(servName, &st)) && (st.st_mode & S_IFSOCK)) + { + struct sockaddr_un *saun= calloc(1, sizeof(struct sockaddr_un)); + localInfo= (struct addrinfo *)calloc(1, sizeof(struct addrinfo)); + localInfo->ai_family= AF_UNIX; + localInfo->ai_socktype= SOCK_STREAM; + localInfo->ai_addrlen= sizeof(struct sockaddr_un); + localInfo->ai_addr= (struct sockaddr *)saun; + /*saun->sun_len= sizeof(struct sockaddr_un);*/ + saun->sun_family= AF_UNIX; + memcpy(saun->sun_path, servName, servSize); + saun->sun_path[servSize]= '\0'; + addrInfo= localInfo; + interpreterProxy->signalSemaphoreWithIndex(resolverSema); + return; + } + } + + memset(&request, 0, sizeof(request)); + + if (flags & SQ_SOCKET_NUMERIC) request.ai_flags |= AI_NUMERICHOST; + if (flags & SQ_SOCKET_PASSIVE) request.ai_flags |= AI_PASSIVE; + + switch (family) + { + case SQ_SOCKET_FAMILY_LOCAL: request.ai_family= AF_UNIX; break; + case SQ_SOCKET_FAMILY_INET4: request.ai_family= AF_INET; break; + case SQ_SOCKET_FAMILY_INET6: request.ai_family= AF_INET6; break; + } + + switch (type) + { + case SQ_SOCKET_TYPE_STREAM: request.ai_socktype= SOCK_STREAM; break; + case SQ_SOCKET_TYPE_DGRAM: request.ai_socktype= SOCK_DGRAM; break; + } + + switch (protocol) + { + case SQ_SOCKET_PROTOCOL_TCP: request.ai_protocol= IPPROTO_TCP; break; + case SQ_SOCKET_PROTOCOL_UDP: request.ai_protocol= IPPROTO_UDP; break; + } + + gaiError= getaddrinfo(hostSize ? host : 0, servSize ? serv : 0, &request, &addrList); + + if (gaiError) + { + /* Linux gives you either with correct NI_* bit definitions and no EAI_* definitions at all + or with incorrect NI_* bit definitions and the EAI_* definitions we need. + We cannot distinguish between impossible constraints and genuine lookup failure, so err conservatively. */ +# if defined(EAI_BADHINTS) + if (EAI_BADHINTS != gaiError) + { + logTrace("getaddrinfo: %s\n", gai_strerror(gaiError)); + lastError= gaiError; + goto fail; + } +# else + logTrace("getaddrinfo: %s\n", gai_strerror(gaiError)); +# endif + addrList= 0; /* succeed with zero results for impossible constraints */ + } + + addrInfo= addrList; + interpreterProxy->signalSemaphoreWithIndex(resolverSema); + return; + + fail: + success(false); + return; +} + +sqInt sqResolverGetAddressInfoFamily(void) +{ + if (!addrInfo) + { + success(false); + return 0; + } + + switch (addrInfo->ai_family) + { + case AF_UNIX: return SQ_SOCKET_FAMILY_LOCAL; + case AF_INET: return SQ_SOCKET_FAMILY_INET4; + case AF_INET6: return SQ_SOCKET_FAMILY_INET6; + } + + return SQ_SOCKET_FAMILY_UNSPECIFIED; +} + + +sqInt sqResolverGetAddressInfoType(void) +{ + if (!addrInfo) + { + success(false); + return 0; + } + + switch (addrInfo->ai_socktype) + { + case SOCK_STREAM: return SQ_SOCKET_TYPE_STREAM; + case SOCK_DGRAM: return SQ_SOCKET_TYPE_DGRAM; + } + + return SQ_SOCKET_TYPE_UNSPECIFIED; +} + + +sqInt sqResolverGetAddressInfoProtocol(void) +{ + if (!addrInfo) + { + success(false); + return 0; + } + + switch (addrInfo->ai_protocol) + { + case IPPROTO_TCP: return SQ_SOCKET_PROTOCOL_TCP; + case IPPROTO_UDP: return SQ_SOCKET_PROTOCOL_UDP; + } + + return SQ_SOCKET_PROTOCOL_UNSPECIFIED; +} + + +sqInt sqResolverGetAddressInfoNext(void) +{ + return (addrInfo && (addrInfo= addrInfo->ai_next)) ? true : false; +} + + +void sqResolverGetNameInfoSizeFlags(char *addr, sqInt addrSize, sqInt flags) +{ + int niFlags= 0; + int gaiError= 0; + + logTrace( "GetNameInfoSizeFlags %p %ld %ld\n", addr, addrSize, flags); + + nameInfoValid= 0; + + if (!addressValid(addr, addrSize)) + goto fail; + + niFlags |= NI_NOFQDN; + + if (flags & SQ_SOCKET_NUMERIC) niFlags |= (NI_NUMERICHOST | NI_NUMERICSERV); + + /*dumpAddr(socketAddress(addr), addrSize - AddressHeaderSize); logTrace("%02x\n", niFlags);*/ + + gaiError= getnameinfo(socketAddress(addr), addrSize - AddressHeaderSize, + hostNameInfo, sizeof(hostNameInfo), + servNameInfo, sizeof(servNameInfo), + niFlags); + + if (gaiError) + { + logTrace("getnameinfo: %s\n", gai_strerror(gaiError)); + lastError= gaiError; + goto fail; + } + + nameInfoValid= 1; + interpreterProxy->signalSemaphoreWithIndex(resolverSema); + return; + + fail: + success(false); +} + + +sqInt sqResolverGetNameInfoHostSize(void) +{ + if (!nameInfoValid) + { + success(false); + return 0; + } + return strlen(hostNameInfo); +} + + +void sqResolverGetNameInfoHostResultSize(char *name, sqInt nameSize) +{ + int len; + + if (!nameInfoValid) + goto fail; + + len= strlen(hostNameInfo); + if (nameSize < len) + goto fail; + + memcpy(name, hostNameInfo, len); + return; + + fail: + success(false); +} + + +sqInt sqResolverGetNameInfoServiceSize(void) +{ + if (!nameInfoValid) + { + success(false); + return 0; + } + return strlen(servNameInfo); +} + + +void sqResolverGetNameInfoServiceResultSize(char *name, sqInt nameSize) +{ + int len; + + if (!nameInfoValid) + goto fail; + + len= strlen(servNameInfo); + if (nameSize < len) + goto fail; + + memcpy(name, servNameInfo, len); + return; + + fail: + success(false); +} + + +sqInt sqResolverHostNameSize(void) +{ + char buf[MAXHOSTNAMELEN+1]; + if (gethostname(buf, sizeof(buf))) + { + success(false); + return 0; + } + return strlen(buf); +} + + +void sqResolverHostNameResultSize(char *name, sqInt nameSize) +{ + char buf[MAXHOSTNAMELEN+1]; + int len; + if (gethostname(buf, sizeof(buf)) || (nameSize < (len= strlen(buf)))) + { + success(false); + return; + } + memcpy(name, buf, len); +} + +void nameResolverInit(sqInt resolverSemaIndex){ + gethostname(localHostName, MAXHOSTNAMELEN); + localHostAddress = nameToAddr(localHostName); + resolverSema = resolverSemaIndex; +} + +void nameResolverFini(){ + resolverSema = 0; +} From 119d311f380fa90eed451e6d83839958264f8119 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Wed, 8 Sep 2021 12:44:24 +0200 Subject: [PATCH 06/16] Removing unused primitives --- smalltalksrc/VMMaker/SocketPlugin.class.st | 40 ---------------------- 1 file changed, 40 deletions(-) diff --git a/smalltalksrc/VMMaker/SocketPlugin.class.st b/smalltalksrc/VMMaker/SocketPlugin.class.st index cef31ce346..36f0caa0a2 100644 --- a/smalltalksrc/VMMaker/SocketPlugin.class.st +++ b/smalltalksrc/VMMaker/SocketPlugin.class.st @@ -667,27 +667,6 @@ SocketPlugin >> primitiveSocketAbortConnection: socket [ self sqSocketAbortConnection: s] ] -{ #category : #primitives } -SocketPlugin >> primitiveSocketAcceptFrom: sockHandle rcvBufferSize: recvBufSize sndBufSize: sendBufSize semaIndex: semaIndex [ - | socketOop s serverSocket | - - - self primitive: 'primitiveSocketAccept' - parameters: #(Oop SmallInteger SmallInteger SmallInteger ). - serverSocket := self socketValueOf: sockHandle. - - interpreterProxy failed - ifFalse: [socketOop := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self socketRecordSize. - s := self socketValueOf: socketOop. - self - sqSocket: s - AcceptFrom: serverSocket - RecvBytes: recvBufSize - SendBytes: sendBufSize - SemaID: semaIndex]. - ^ socketOop -] - { #category : #primitives } SocketPlugin >> primitiveSocketAcceptFrom: sockHandle rcvBufferSize: recvBufSize sndBufSize: sendBufSize semaIndex: semaIndex readSemaIndex: aReadSema writeSemaIndex: aWriteSema [ | socketOop s serverSocket | @@ -761,25 +740,6 @@ SocketPlugin >> primitiveSocketConnectionStatus: socket [ ^ status asSmallIntegerObj ] -{ #category : #primitives } -SocketPlugin >> primitiveSocketCreateNetwork: netType type: socketType receiveBufferSize: recvBufSize sendBufSize: sendBufSize semaIndex: semaIndex [ - | socketOop s okToCreate | - - self primitive: 'primitiveSocketCreate' parameters: #(#SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger ). - - socketOop := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self socketRecordSize. - s := self socketValueOf: socketOop. - interpreterProxy failed ifFalse: - [self - sqSocket: s - CreateNetType: netType - SocketType: socketType - RecvBytes: recvBufSize - SendBytes: sendBufSize - SemaID: semaIndex]. - ^socketOop -] - { #category : #primitives } SocketPlugin >> primitiveSocketCreateNetwork: netType type: socketType receiveBufferSize: recvBufSize sendBufSize: sendBufSize semaIndex: semaIndex readSemaIndex: aReadSema writeSemaIndex: aWriteSema [ | socketOop s okToCreate | From c1c58220a214e3f5ef7580c01a67e9ddeb30a4e7 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Wed, 8 Sep 2021 18:09:25 +0200 Subject: [PATCH 07/16] Cleaning up Socket implementation --- plugins/SocketPlugin/include/SocketPlugin.h | 24 +- plugins/SocketPlugin/src/SocketPluginImpl.c | 346 ++++++-------------- plugins/SocketPlugin/src/nameResolverImpl.c | 8 - 3 files changed, 112 insertions(+), 266 deletions(-) diff --git a/plugins/SocketPlugin/include/SocketPlugin.h b/plugins/SocketPlugin/include/SocketPlugin.h index ee5fb29d2d..252b98f6de 100644 --- a/plugins/SocketPlugin/include/SocketPlugin.h +++ b/plugins/SocketPlugin/include/SocketPlugin.h @@ -31,7 +31,6 @@ void sqSocketCreateNetTypeSocketTypeRecvBytesSendBytesSemaIDReadSemaIDWriteSema void sqSocketCreateRawProtoTypeRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(SocketPtr s, sqInt domain, sqInt protocol, sqInt recvBufSize, sqInt sendBufSize, sqInt semaIndex, sqInt readSemaIndex, sqInt writeSemaIndex); void sqSocketDestroy(SocketPtr s); sqInt sqSocketError(SocketPtr s); -void sqSocketListenOnPort(SocketPtr s, sqInt port); sqInt sqSocketLocalAddress(SocketPtr s); sqInt sqSocketLocalPort(SocketPtr s); sqInt sqSocketReceiveDataAvailable(SocketPtr s); @@ -40,16 +39,11 @@ sqInt sqSocketRemoteAddress(SocketPtr s); sqInt sqSocketRemotePort(SocketPtr s); sqInt sqSocketSendDataBufCount(SocketPtr s, char *buf, sqInt bufSize); sqInt sqSocketSendDone(SocketPtr s); -/* ar 7/16/1999: New primitives for accept(). Note: If accept() calls are not supported simply make the calls fail and the old connection style will be used. */ -void sqSocketListenOnPortBacklogSize(SocketPtr s, sqInt port, sqInt backlogSize); -void sqSocketListenOnPortBacklogSizeInterface(SocketPtr s, sqInt port, sqInt backlogSize, sqInt addr); void sqSocketAcceptFromRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(SocketPtr s, SocketPtr serverSocket, sqInt recvBufSize, sqInt sendBufSize, sqInt semaIndex, sqInt readSemaIndex, sqInt writeSemaIndex); sqInt sqSocketReceiveUDPDataBufCountaddressportmoreFlag(SocketPtr s, char *buf, sqInt bufSize, sqInt *address, sqInt *port, sqInt *moreFlag); sqInt sqSockettoHostportSendDataBufCount(SocketPtr s, sqInt address, sqInt port, char *buf, sqInt bufSize); sqInt sqSocketSetOptionsoptionNameStartoptionNameSizeoptionValueStartoptionValueSizereturnedValue(SocketPtr s, char *optionName, sqInt optionNameSize, char *optionValue, sqInt optionValueSize, sqInt *result); sqInt sqSocketGetOptionsoptionNameStartoptionNameSizereturnedValue(SocketPtr s, char *optionName, sqInt optionNameSize, sqInt *result); -/* tpr 4/12/06 add declarations for two new socket routines */ -void sqSocketBindToPort(SocketPtr s, int addr, int port); void sqSocketSetReusable(SocketPtr s); void sqResolverGetAddressInfoHostSizeServiceSizeFlagsFamilyTypeProtocol(char *hostName, sqInt hostSize, char *servName, sqInt servSize, @@ -73,12 +67,22 @@ void sqResolverGetNameInfoServiceResultSize(char *name, sqInt nameSize); sqInt sqResolverHostNameSize(void); void sqResolverHostNameResultSize(char *name, sqInt nameSize); -void sqSocketBindToAddressSize(SocketPtr s, char *addr, sqInt addrSize); -void sqSocketListenBacklog(SocketPtr s, sqInt backlogSize); -void sqSocketConnectToAddressSize(SocketPtr s, char *addr, sqInt addrSize); - sqInt sqSocketLocalAddressSize(SocketPtr s); void sqSocketLocalAddressResultSize(SocketPtr s, char *addr, int addrSize); sqInt sqSocketRemoteAddressSize(SocketPtr s); void sqSocketRemoteAddressResultSize(SocketPtr s, char *addr, int addrSize); +void socketConnectToAddressSize(SocketPtr s, void* addr, size_t addrSize); +void socketListenOn(SocketPtr s, void* address, size_t addressSize, int backlogSize); +void socketBindTo(SocketPtr s, void *address, size_t addrSize); + +void* newIP4SockAddr(int address, int port); +size_t ip4SockSize(); + +/* family */ + +#define SQ_SOCKET_FAMILY_UNSPECIFIED 0 +#define SQ_SOCKET_FAMILY_LOCAL 1 +#define SQ_SOCKET_FAMILY_INET4 2 +#define SQ_SOCKET_FAMILY_INET6 3 +#define SQ_SOCKET_FAMILY_MAX 4 diff --git a/plugins/SocketPlugin/src/SocketPluginImpl.c b/plugins/SocketPlugin/src/SocketPluginImpl.c index 99855ff5f4..7891d67ab0 100644 --- a/plugins/SocketPlugin/src/SocketPluginImpl.c +++ b/plugins/SocketPlugin/src/SocketPluginImpl.c @@ -43,6 +43,7 @@ static int one = 1; # define ERROR_WOULD_BLOCK EWOULDBLOCK #endif + union sockaddr_any { struct sockaddr sa; @@ -594,124 +595,33 @@ sqInt sqSocketConnectionStatus(SocketPtr s) return SOCKETSTATE(s); } +void socketListenOn(SocketPtr s, void* address, size_t addressSize, int backlogSize) { + struct sockaddr* addr = (struct sockaddr*) address; -/* TCP => start listening for incoming connections. - * UDP => associate the local port number with the socket. - */ -void sqSocketListenOnPort(SocketPtr s, sqInt port) -{ - sqSocketListenOnPortBacklogSize(s, port, 1); -} - -void sqSocketListenOnPortBacklogSizeInterface(SocketPtr s, sqInt port, sqInt backlogSize, sqInt addr) -{ - struct sockaddr_in saddr; - - if (!socketValid(s)) - return; - - /* only TCP sockets have a backlog */ - if ((backlogSize > 1) && (s->socketType != TCPSocketType)) - { - success(false); - return; - } - - PSP(s)->multiListen= (backlogSize > 1); - logTrace("listenOnPortBacklogSize(%d, %ld)\n", SOCKET(s), backlogSize); - memset(&saddr, 0, sizeof(saddr)); - saddr.sin_family= AF_INET; - saddr.sin_port= htons((short)port); - saddr.sin_addr.s_addr= htonl(addr); - bind(SOCKET(s), (struct sockaddr*) &saddr, sizeof(saddr)); - if (TCPSocketType == s->socketType) - { - /* --- TCP --- */ - listen(SOCKET(s), backlogSize); - SOCKETSTATE(s)= WaitingForConnection; - aioEnable(SOCKET(s), PSP(s), 0); - aioHandle(SOCKET(s), acceptHandler, AIO_RX); /* R => accept() */ - } - else - { - /* --- UDP/RAW --- */ - } -} - -void sqSocketListenOnPortBacklogSize(SocketPtr s, sqInt port, sqInt backlogSize) -{ - sqSocketListenOnPortBacklogSizeInterface(s, port, backlogSize, INADDR_ANY); -} - -/* TCP => open a connection. - * UDP => set remote address. - */ -void sqSocketConnectToPort(SocketPtr s, sqInt addr, sqInt port) -{ - struct sockaddr_in saddr; + if (!socketValid(s)) + return; - if (!socketValid(s)) - return; - logTrace("connectTo(%d)\n", SOCKET(s)); - memset(&saddr, 0, sizeof(saddr)); - saddr.sin_family= AF_INET; - saddr.sin_port= htons((short)port); - saddr.sin_addr.s_addr= htonl(addr); - if (TCPSocketType != s->socketType) - { - /* --- UDP/RAW --- */ - if (SOCKET(s) >= 0) - { - int result; - memcpy((void *)&SOCKETPEER(s), (void *)&saddr, sizeof(saddr)); - SOCKETPEERSIZE(s)= sizeof(struct sockaddr_in); - result= connect(SOCKET(s), (struct sockaddr *)&saddr, sizeof(saddr)); - if (result == 0) - SOCKETSTATE(s)= Connected; + /* only TCP sockets have a backlog */ + if ((backlogSize > 1) && (s->socketType != TCPSocketType)) { + success(false); + return; } - } - else - { - /* --- TCP --- */ - int result; - int lastError; - - aioEnable(SOCKET(s), PSP(s), 0); - struct sockaddr_in * p = &saddr; - result= connect(SOCKET(s), (struct sockaddr *)p, sizeof(saddr)); - lastError = getLastSocketError(); + PSP(s)->multiListen = (backlogSize > 1); + logTrace("listenOnPortBacklogSize(%d, %ld)\n", SOCKET(s), backlogSize); - if (result == 0) - { - /* connection completed synchronously */ - logWarnFromErrno("sqConnectToPort"); - logWarn("LastSocketError: %d", getLastSocketError()); + bind(SOCKET(s), addr, addressSize); - SOCKETSTATE(s)= Connected; - notify(PSP(s), CONN_NOTIFY); - setLinger(SOCKET(s), 1); - } - else - { - if (lastError == ERROR_IN_PROGRESS || lastError == ERROR_WOULD_BLOCK) { - /* asynchronous connection in progress */ - SOCKETSTATE(s)= WaitingForConnection; - aioHandle(SOCKET(s), connectHandler, AIO_WX); /* W => connect() */ - } - else - { - /* connection error */ - logWarnFromErrno("sqConnectToPort"); - logWarn("LastSocketError: %d", getLastSocketError()); - - SOCKETSTATE(s)= Unconnected; - SOCKETERROR(s)= lastError; - notify(PSP(s), CONN_NOTIFY); - } + if (TCPSocketType == s->socketType) { + /* --- TCP --- */ + listen(SOCKET(s), backlogSize); + SOCKETSTATE(s) = WaitingForConnection; + aioEnable(SOCKET(s), PSP(s), 0); + aioHandle(SOCKET(s), acceptHandler, AIO_RX); /* R => accept() */ + } else { + /* --- UDP/RAW --- */ } - } } void sqSocketAcceptFromRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(SocketPtr s, SocketPtr serverSocket, sqInt recvBufSize, sqInt sendBufSize, sqInt semaIndex, sqInt readSemaIndex, sqInt writeSemaIndex) @@ -1168,21 +1078,6 @@ sqInt sqSockettoHostportSendDataBufCount(SocketPtr s, sqInt address, sqInt port, /*** socket options ***/ -/* NOTE: we only support the portable options here as an incentive for - people to write portable Squeak programs. If you need - non-portable socket options then go write yourself a plugin - specific to your platform. This decision is unilateral and - non-negotiable. - ikp - NOTE: we only support the integer-valued options because the code - in SocketPlugin doesn't seem able to cope with the others. - (Personally I think that things like SO_SNDTIMEO et al would - by far more interesting than the majority of things on this - list, but there you go...) - NOTE: if your build fails because of a missing option in this list, - simply DELETE THE OPTION (or comment it out) and then send - me mail (ian.piumarta@inria.fr) to let me know about it. - */ - typedef struct { char *name; /* name as known to Squeak */ @@ -1354,27 +1249,6 @@ sqInt sqSocketGetOptionsoptionNameStartoptionNameSizereturnedValue(SocketPtr s, return -1; } -void sqSocketBindToPort(SocketPtr s, int addr, int port) -{ - struct sockaddr_in inaddr; - privateSocketStruct *pss= PSP(s); - - if (!socketValid(s)) - return; - - /* bind the socket */ - memset(&inaddr, 0, sizeof(inaddr)); - inaddr.sin_family= AF_INET; - inaddr.sin_port= htons(port); - inaddr.sin_addr.s_addr= htonl(addr); - - if (bind(SOCKET(s), (struct sockaddr *)&inaddr, sizeof(struct sockaddr_in)) < 0) { - pss->sockError= getLastSocketError(); - success(false); - return; - } -} - void sqSocketSetReusable(SocketPtr s) { size_t bufSize; @@ -1392,22 +1266,6 @@ void sqSocketSetReusable(SocketPtr s) } } -sqInt sqSocketAddressSizeGetPort(char *addr, sqInt addrSize); -void sqSocketAddressSizeSetPort(char *addr, sqInt addrSize, sqInt port); - -void sqSocketBindToAddressSize(SocketPtr s, char *addr, sqInt addrSize); -void sqSocketListenBacklog(SocketPtr s, sqInt backlogSize); -void sqSocketConnectToAddressSize(SocketPtr s, char *addr, sqInt addrSize); - -sqInt sqSocketLocalAddressSize(SocketPtr s); -void sqSocketLocalAddressResultSize(SocketPtr s, char *addr, int addrSize); -sqInt sqSocketRemoteAddressSize(SocketPtr s); -void sqSocketRemoteAddressResultSize(SocketPtr s, char *addr, int addrSize); - -sqInt sqSocketSendUDPToSizeDataBufCount(SocketPtr s, char *addr, sqInt addrSize, char *buf, sqInt bufSize); -sqInt sqSocketReceiveUDPDataBufCount(SocketPtr s, char *buf, sqInt bufSize); - - /* ---- address manipulation ---- */ @@ -1438,112 +1296,104 @@ void sqSocketAddressSizeSetPort(char *addr, sqInt addrSize, sqInt port) } -/* ---- circuit setup ---- */ - +void socketBindTo(SocketPtr s, void *address, size_t addrSize) { -void sqSocketBindToAddressSize(SocketPtr s, char *addr, sqInt addrSize) -{ - privateSocketStruct *pss= PSP(s); + struct sockaddr* addr = (struct sockaddr*) address; - if (!(socketValid(s) && addressValid(addr, addrSize))) - goto fail; + privateSocketStruct *pss = PSP(s); - if (bind(SOCKET(s), socketAddress(addr), addressSize(addr)) == 0) - return; + if (!socketValid(s)){ + success(false); + return; + } - pss->sockError= getLastSocketError(); + if (bind(SOCKET(s), addr, addrSize) == 0) + return; - fail: - success(false); + pss->sockError = getLastSocketError(); + success(false); } -void sqSocketListenBacklog(SocketPtr s, sqInt backlogSize) -{ - if (!socketValid(s)) - goto fail; +void socketConnectToAddressSize(SocketPtr s, void* address, size_t addrSize){ - if ((backlogSize > 1) && (s->socketType != TCPSocketType)) - goto fail; + /* TCP => open a connection. + * UDP => set remote address. + */ - PSP(s)->multiListen= (backlogSize > 1); + struct sockaddr* addr = (struct sockaddr*) address; - logTrace( "listenBacklog(%d, %ld)\n", SOCKET(s), backlogSize); + if (!socketValid(s)) { + success(false); + return; + } - if (TCPSocketType == s->socketType) - { - listen(SOCKET(s), backlogSize); /* acceptHandler catches errors */ - SOCKETSTATE(s)= WaitingForConnection; - aioEnable(SOCKET(s), PSP(s), 0); - aioHandle(SOCKET(s), acceptHandler, AIO_RX); /* R => accept() */ - } + logTrace("connectToAddressSize(%d)\n", SOCKET(s)); - return; + if (TCPSocketType != s->socketType) { - fail: - success(false); - return; -} + /* --- UDP/RAW --- */ + if (SOCKET(s) >= 0) { -void sqSocketConnectToAddressSize(SocketPtr s, char *addr, sqInt addrSize) -{ - /* TCP => open a connection. - * UDP => set remote address. - */ - if (!(socketValid(s) && addressValid(addr, addrSize))) - { - success(false); - return; - } + int result; - logTrace( "connectToAddressSize(%d)\n", SOCKET(s)); + memcpy((void *) &SOCKETPEER(s), addr, addrSize); - if (TCPSocketType != s->socketType) /* --- UDP/RAW --- */ - { - if (SOCKET(s) >= 0) - { - int result; - memcpy((void *)&SOCKETPEER(s), socketAddress(addr), addressSize(addr)); - SOCKETPEERSIZE(s)= addressSize(addr); - result= connect(SOCKET(s), socketAddress(addr), addressSize(addr)); - if (result == 0) - SOCKETSTATE(s)= Connected; - } - } - else /* --- TCP --- */ - { - int result; - aioEnable(SOCKET(s), PSP(s), 0); - result= connect(SOCKET(s), socketAddress(addr), addressSize(addr)); - logTrace( "connect() => %d\n", result); - if (result == 0) + SOCKETPEERSIZE(s) = addrSize; + + result = connect(SOCKET(s), addr, addrSize); + + if (result == 0) + SOCKETSTATE(s) = Connected; + } + } else /* --- TCP --- */ { - /* connection completed synchronously */ - logWarnFromErrno("sqConnectToPort"); - logWarn("LastSocketError: %d", getLastSocketError()); - - SOCKETSTATE(s)= Connected; - notify(PSP(s), CONN_NOTIFY); - setLinger(SOCKET(s), 1); - } - else { - int lastError = getLastSocketError(); - if (lastError == ERROR_IN_PROGRESS || lastError == ERROR_WOULD_BLOCK) { - /* asynchronous connection in progress */ - SOCKETSTATE(s)= WaitingForConnection; - aioHandle(SOCKET(s), connectHandler, AIO_WX); /* W => connect() */ - } - else - { - /* connection error */ - logWarnFromErrno("sqConnectToAddressSize"); - SOCKETSTATE(s)= Unconnected; - SOCKETERROR(s)= errno; - notify(PSP(s), CONN_NOTIFY); + int result; + aioEnable(SOCKET(s), PSP(s), 0); + result = connect(SOCKET(s), addr, addrSize); + + logTrace("connect() => %d\n", result); + + if (result == 0) { + /* connection completed synchronously */ + logWarnFromErrno("sqConnectToPort"); + logWarn("LastSocketError: %d", getLastSocketError()); + + SOCKETSTATE(s) = Connected; + notify(PSP(s), CONN_NOTIFY); + setLinger(SOCKET(s), 1); + } else { + int lastError = getLastSocketError(); + if (lastError == ERROR_IN_PROGRESS || lastError == ERROR_WOULD_BLOCK) { + /* asynchronous connection in progress */ + SOCKETSTATE(s) = WaitingForConnection; + aioHandle(SOCKET(s), connectHandler, AIO_WX); /* W => connect() */ + } else { + /* connection error */ + logWarnFromErrno("sqConnectToAddressSize"); + SOCKETSTATE(s) = Unconnected; + SOCKETERROR(s) = errno; + notify(PSP(s), CONN_NOTIFY); } - } - } + } + } +} + +void* newIP4SockAddr(int address, int port) { + struct sockaddr_in* r = (struct sockaddr_in*) malloc(sizeof(struct sockaddr_in)); + + memset(r, 0, sizeof(struct sockaddr_in)); + + r->sin_family = AF_INET; + r->sin_port = htons((short)port); + r->sin_addr.s_addr = htonl(address); + + return r; +} + +size_t ip4SockSize(){ + return sizeof(struct sockaddr_in); } diff --git a/plugins/SocketPlugin/src/nameResolverImpl.c b/plugins/SocketPlugin/src/nameResolverImpl.c index 2bd6169467..40e343a69c 100644 --- a/plugins/SocketPlugin/src/nameResolverImpl.c +++ b/plugins/SocketPlugin/src/nameResolverImpl.c @@ -33,14 +33,6 @@ static struct addrinfo *localInfo= 0; #define SQ_SOCKET_NUMERIC (1<<0) #define SQ_SOCKET_PASSIVE (1<<1) -/* family */ - -#define SQ_SOCKET_FAMILY_UNSPECIFIED 0 -#define SQ_SOCKET_FAMILY_LOCAL 1 -#define SQ_SOCKET_FAMILY_INET4 2 -#define SQ_SOCKET_FAMILY_INET6 3 -#define SQ_SOCKET_FAMILY_MAX 4 - /* type */ #define SQ_SOCKET_TYPE_UNSPECIFIED 0 From 01b21b8963ebcf7c1c0268b7394e4e78f038a6f2 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Wed, 8 Sep 2021 18:12:37 +0200 Subject: [PATCH 08/16] Refactoring of socket plugin --- smalltalksrc/VMMaker/SocketPlugin.class.st | 343 +++++++++++++-------- 1 file changed, 210 insertions(+), 133 deletions(-) diff --git a/smalltalksrc/VMMaker/SocketPlugin.class.st b/smalltalksrc/VMMaker/SocketPlugin.class.st index 36f0caa0a2..41cb611a63 100644 --- a/smalltalksrc/VMMaker/SocketPlugin.class.st +++ b/smalltalksrc/VMMaker/SocketPlugin.class.st @@ -14,11 +14,6 @@ SocketPlugin class >> declareCVarsIn: aCCodeGenerator [ self declareC: (self instVarNames select: [:ivn| ivn first = $s and: [ivn second isUppercase]]) as: #'void *' in: aCCodeGenerator." - aCCodeGenerator var: 'sDSAfn' type: 'void *'. - aCCodeGenerator var: 'sHSAfn' type: 'void *'. - aCCodeGenerator var: 'sCCTPfn' type: 'void *'. - aCCodeGenerator var: 'sCCLOPfn' type: 'void *'. - aCCodeGenerator var: 'sCCSOTfn' type: 'void *'. aCCodeGenerator addHeaderFile: '"SocketPlugin.h"' ] @@ -34,6 +29,91 @@ SocketPlugin class >> requiresPlatformFiles [ ^true ] +{ #category : #'accessing - ip4' } +SocketPlugin >> addressStructFor: aSocketAddress [ + + + + | addressType | + + addressType := self getAddressType: aSocketAddress. + interpreterProxy failed ifTrue: [ ^ nil ]. + + addressType = self ip4AddressType + ifTrue: [ + (self isValidIp4Address: aSocketAddress) + ifFalse: [ ^ nil ]. + ^ self newIP4SockAddr: (self getIp4Address: aSocketAddress) _: (self getIp4Port: aSocketAddress) ]. + + ^ interpreterProxy primitiveFail. +] + +{ #category : #'accessing - ip4' } +SocketPlugin >> addressStructSizeFor: aSocketAddress [ + + + + | addressType | + + addressType := self getAddressType: aSocketAddress. + interpreterProxy failed ifTrue: [ ^ nil ]. + + addressType = self ip4AddressType + ifTrue: [ ^ self ip4SockSize ]. + + ^ interpreterProxy primitiveFail. +] + +{ #category : #'accessing - ip4' } +SocketPlugin >> getAddressType: anAddressOop [ + + + + | type | + + (interpreterProxy isPointers: anAddressOop) + ifFalse: [ interpreterProxy primitiveFail. ^ nil ]. + + (interpreterProxy slotSizeOf: anAddressOop) >= 1 + ifFalse: [ interpreterProxy primitiveFail. ^ nil ]. + + type := interpreterProxy fetchInteger: 0 ofObject: anAddressOop. + interpreterProxy failed ifTrue: [ ^ nil ]. + + ^ type +] + +{ #category : #'accessing - ip4' } +SocketPlugin >> getIp4Address: anAddressOop [ + + "IPv4 Addresses are represented by an object with a smallinteger saying the address type (2 for IPv4), a 4 bytes bytearray as second instance variable, and a smallInteger as port number as third instance variable. If it does not have port the value is -1. + It returns the int32 representing the address in host order" + + + + + | ptrToByteArray | + ptrToByteArray := interpreterProxy firstIndexableField: (interpreterProxy fetchPointer: 1 ofObject: anAddressOop). + + ^ (ptrToByteArray at: 3 ) + + ((ptrToByteArray at: 2) <<8) + + ((ptrToByteArray at: 1) <<16) + + ((ptrToByteArray at: 0) <<24) + + +] + +{ #category : #'accessing - ip4' } +SocketPlugin >> getIp4Port: anAddressOop [ + + + + "IPv4 Addresses are represented by an object with a smallinteger saying the address type (2 for IPv4), a 4 bytes bytearray as second instance variable, and a smallInteger as port number as third instance variable. If it does not have port the value is -1. + It returns the int32 representing the port in host order" + + ^ interpreterProxy fetchInteger: 2 ofObject: anAddressOop +] + { #category : #'initialize-release' } SocketPlugin >> initialiseModule [ @@ -60,6 +140,44 @@ SocketPlugin >> intToNetAddress: addr [ ^ netAddressOop ] +{ #category : #'accessing - ip4' } +SocketPlugin >> ip4AddressType [ + + + + ^ 2 +] + +{ #category : #'accessing - ip4' } +SocketPlugin >> isValidIp4Address: anAddressOop [ + + + + "IPv4 Addresses are represented by an object with a smallinteger saying the address type (2 for IPv4), a 4 bytes bytearray as second instance variable, and a smallInteger as port number as third instance variable. If it does not have port the value is -1." + + | maybeByteArray maybeInteger type | + + type := self getAddressType: anAddressOop. + interpreterProxy failed ifTrue: [ ^ false ]. + + type = self ip4AddressType ifFalse: [ interpreterProxy primitiveFail. ^ false ]. + + maybeByteArray := interpreterProxy fetchPointer: 1 ofObject: anAddressOop. + + (interpreterProxy isBytes: maybeByteArray) + ifFalse: [ interpreterProxy primitiveFail. ^ false ]. + + (interpreterProxy stSizeOf: maybeByteArray) = 4 + ifFalse: [ interpreterProxy primitiveFail. ^ false ]. + + maybeInteger := interpreterProxy fetchPointer: 2 ofObject: anAddressOop. + + (interpreterProxy isIntegerObject: maybeInteger) + ifFalse: [ interpreterProxy primitiveFail. ^ false ]. + + ^ true +] + { #category : #primitives } SocketPlugin >> netAddressToInt: ptrToByteArray [ "Convert the given internet network address (represented as a four-byte ByteArray) into a 32-bit integer. Fail if the given ptrToByteArray does not appear to point to a four-byte ByteArray." @@ -84,7 +202,7 @@ SocketPlugin >> primitiveInitializeNetwork: resolverSemaIndex [ interpreterProxy success: err = 0 ] -{ #category : #primitives } +{ #category : #'primitives - resolver - old' } SocketPlugin >> primitiveResolverAbortLookup [ self primitive: 'primitiveResolverAbortLookup'. @@ -92,7 +210,7 @@ SocketPlugin >> primitiveResolverAbortLookup [ self sqResolverAbort ] -{ #category : #primitives } +{ #category : #'primitives - resolver - old' } SocketPlugin >> primitiveResolverAddressLookupResult [ | sz s | self primitive: 'primitiveResolverAddressLookupResult'. @@ -104,14 +222,14 @@ SocketPlugin >> primitiveResolverAddressLookupResult [ ^ s ] -{ #category : #primitives } +{ #category : #'primitives - resolver - old' } SocketPlugin >> primitiveResolverError [ self primitive: 'primitiveResolverError'. ^ self sqResolverError asSmallIntegerObj ] -{ #category : #'ipv6 primitives' } +{ #category : #'primitives - resolver' } SocketPlugin >> primitiveResolverGetAddressInfoFamily [ | family | @@ -123,7 +241,7 @@ SocketPlugin >> primitiveResolverGetAddressInfoFamily [ ^family asSmallIntegerObj] ] -{ #category : #'ipv6 primitives' } +{ #category : #'primitives - resolver' } SocketPlugin >> primitiveResolverGetAddressInfoHost: hostName service: servName flags: flags family: family type: type protocol: protocol [ | hostSize servSize | @@ -138,7 +256,7 @@ SocketPlugin >> primitiveResolverGetAddressInfoHost: hostName service: servName Flags: flags Family: family Type: type Protocol: protocol] ] -{ #category : #'ipv6 primitives' } +{ #category : #'primitives - resolver' } SocketPlugin >> primitiveResolverGetAddressInfoNext [ | more | @@ -149,7 +267,7 @@ SocketPlugin >> primitiveResolverGetAddressInfoNext [ ^more asBooleanObj ] -{ #category : #'ipv6 primitives' } +{ #category : #'primitives - resolver' } SocketPlugin >> primitiveResolverGetAddressInfoProtocol [ | protocol | @@ -161,7 +279,7 @@ SocketPlugin >> primitiveResolverGetAddressInfoProtocol [ ^protocol asSmallIntegerObj] ] -{ #category : #'ipv6 primitives' } +{ #category : #'primitives - resolver' } SocketPlugin >> primitiveResolverGetAddressInfoResult: socketAddress [ | addrSize | @@ -173,7 +291,7 @@ SocketPlugin >> primitiveResolverGetAddressInfoResult: socketAddress [ self sqResolverGetAddressInfoResult: socketAddress Size: addrSize] ] -{ #category : #'ipv6 primitives' } +{ #category : #'primitives - resolver' } SocketPlugin >> primitiveResolverGetAddressInfoSize [ | size | @@ -185,7 +303,7 @@ SocketPlugin >> primitiveResolverGetAddressInfoSize [ ^size asSmallIntegerObj] ] -{ #category : #'ipv6 primitives' } +{ #category : #'primitives - resolver' } SocketPlugin >> primitiveResolverGetAddressInfoType [ | type | @@ -197,7 +315,7 @@ SocketPlugin >> primitiveResolverGetAddressInfoType [ ^type asSmallIntegerObj] ] -{ #category : #'ipv6 primitives' } +{ #category : #'primitives - resolver' } SocketPlugin >> primitiveResolverGetNameInfo: socketAddress flags: flags [ | addrSize addrBase | @@ -211,7 +329,7 @@ SocketPlugin >> primitiveResolverGetNameInfo: socketAddress flags: flags [ self sqResolverGetNameInfo: addrBase Size: addrSize Flags: flags] ] -{ #category : #'ipv6 primitives' } +{ #category : #'primitives - resolver' } SocketPlugin >> primitiveResolverGetNameInfoHostResult: socketName [ | addrSize | @@ -223,7 +341,7 @@ SocketPlugin >> primitiveResolverGetNameInfoHostResult: socketName [ self sqResolverGetNameInfoHostResult: socketName Size: addrSize] ] -{ #category : #'ipv6 primitives' } +{ #category : #'primitives - resolver' } SocketPlugin >> primitiveResolverGetNameInfoHostSize [ | size | @@ -235,7 +353,7 @@ SocketPlugin >> primitiveResolverGetNameInfoHostSize [ ^size asSmallIntegerObj] ] -{ #category : #'ipv6 primitives' } +{ #category : #'primitives - resolver' } SocketPlugin >> primitiveResolverGetNameInfoServiceResult: socketName [ | addrSize | @@ -247,7 +365,7 @@ SocketPlugin >> primitiveResolverGetNameInfoServiceResult: socketName [ self sqResolverGetNameInfoServiceResult: socketName Size: addrSize] ] -{ #category : #'ipv6 primitives' } +{ #category : #'primitives - resolver' } SocketPlugin >> primitiveResolverGetNameInfoServiceSize [ | size | @@ -259,7 +377,7 @@ SocketPlugin >> primitiveResolverGetNameInfoServiceSize [ ^size asSmallIntegerObj] ] -{ #category : #'ipv6 primitives' } +{ #category : #'primitives - resolver' } SocketPlugin >> primitiveResolverHostNameResult: nameString [ | nameSize | @@ -271,7 +389,7 @@ SocketPlugin >> primitiveResolverHostNameResult: nameString [ self sqResolverHostNameResult: nameString Size: nameSize] ] -{ #category : #'ipv6 primitives' } +{ #category : #'primitives - resolver' } SocketPlugin >> primitiveResolverHostNameSize [ | size | @@ -283,7 +401,7 @@ SocketPlugin >> primitiveResolverHostNameSize [ interpreterProxy failed ifFalse: [^size asSmallIntegerObj]] ] -{ #category : #primitives } +{ #category : #'primitives - resolver - old' } SocketPlugin >> primitiveResolverLocalAddress [ | addr | @@ -292,7 +410,7 @@ SocketPlugin >> primitiveResolverLocalAddress [ ^self intToNetAddress: addr ] -{ #category : #primitives } +{ #category : #'primitives - resolver - old' } SocketPlugin >> primitiveResolverNameLookupResult [ | addr | @@ -301,7 +419,7 @@ SocketPlugin >> primitiveResolverNameLookupResult [ ^self intToNetAddress: addr ] -{ #category : #primitives } +{ #category : #'primitives - resolver - old' } SocketPlugin >> primitiveResolverStartAddressLookup: address [ | addr | @@ -312,7 +430,7 @@ SocketPlugin >> primitiveResolverStartAddressLookup: address [ self sqResolverStartAddrLookup: addr] ] -{ #category : #primitives } +{ #category : #'primitives - resolver - old' } SocketPlugin >> primitiveResolverStartNameLookup: name [ | sz | @@ -323,7 +441,7 @@ SocketPlugin >> primitiveResolverStartNameLookup: name [ self sqResolverStartName: name Lookup: sz] ] -{ #category : #primitives } +{ #category : #'primitives - resolver - old' } SocketPlugin >> primitiveResolverStatus [ | status | @@ -332,57 +450,52 @@ SocketPlugin >> primitiveResolverStatus [ ^status asSmallIntegerObj ] -{ #category : #'ipv6 primitives' } -SocketPlugin >> primitiveSocket: socket bindTo: socketAddress [ +{ #category : #'primitives - connection' } +SocketPlugin >> primitiveSocket: socket bindTo: socketAddressOop [ + + + - | addrSize addrBase s | - + + | s addr addrSize | self primitive: 'primitiveSocketBindTo' parameters: #(#Oop #Oop). - s := self socketValueOf: socket. - addrSize := interpreterProxy byteSizeOf: socketAddress. - addrBase := self cCoerce: (interpreterProxy firstIndexableField: socketAddress) to: 'char *'. - interpreterProxy failed ifFalse: [self sqSocket: s BindToAddress: addrBase Size: addrSize] -] -{ #category : #primitives } -SocketPlugin >> primitiveSocket: socket bindTo: address port: port [ - | addr s | - - self primitive: 'primitiveSocketBindToPort' parameters: #(#Oop #ByteArray #SmallInteger ). - addr := self - netAddressToInt: (self cCoerce: address to: 'unsigned char *'). s := self socketValueOf: socket. - interpreterProxy failed - ifFalse:[self sqSocket: s BindTo: addr Port: port] + + addr := self addressStructFor: socketAddressOop. + addrSize := self addressStructSizeFor: socketAddressOop. + + interpreterProxy failed ifFalse: [ + self socketBindTo: s _: addr _: addrSize. + self free: addr]. ] -{ #category : #'ipv6 primitives' } -SocketPlugin >> primitiveSocket: socket connectTo: socketAddress [ +{ #category : #'primitives - connection' } +SocketPlugin >> primitiveSocket: socket connectTo: socketAddressOop [ + + | addrSize addr s | + + + - | addrSize addrBase s | - + self primitive: 'primitiveSocketConnectTo' parameters: #(#Oop #Oop). + s := self socketValueOf: socket. - addrSize := interpreterProxy byteSizeOf: socketAddress. - addrBase := self cCoerce: (interpreterProxy firstIndexableField: socketAddress) to: 'char *'. - interpreterProxy failed ifFalse: [self sqSocket: s ConnectToAddress: addrBase Size: addrSize] -] -{ #category : #primitives } -SocketPlugin >> primitiveSocket: socket connectTo: address port: port [ - | addr s okToConnect | - - self primitive: 'primitiveSocketConnectToPort' parameters: #(#Oop #ByteArray #SmallInteger ). - addr := self netAddressToInt: (self cCoerce: address to: 'unsigned char *'). + addr := self addressStructFor: socketAddressOop. + addrSize := self addressStructSizeFor: socketAddressOop. - s := self socketValueOf: socket. - interpreterProxy failed ifFalse: - [self sqSocket: s ConnectTo: addr Port: port] + interpreterProxy failed ifFalse: [ + self socket: s ConnectToAddress: addr Size: addrSize. + self free: addr]. + + ] -{ #category : #primitives } +{ #category : #'primitives - status' } SocketPlugin >> primitiveSocket: socket getOptions: optionName [ | s optionNameStart optionNameSize returnedValue errorCode results | @@ -410,57 +523,31 @@ SocketPlugin >> primitiveSocket: socket getOptions: optionName [ ^ results ] -{ #category : #primitives } -SocketPlugin >> primitiveSocket: socket listenOnPort: port [ - "one part of the wierdass dual prim primitiveSocketListenOnPort which - was warped by some demented evil person determined to twist the very - nature of reality" - | s okToListen | - - self primitive: 'primitiveSocketListenOnPort' parameters: #(#Oop #SmallInteger ). - s := self socketValueOf: socket. +{ #category : #'primitives - connection' } +SocketPlugin >> primitiveSocket: socket listenOn: socketAddressOop backLog: backlogSize [ - interpreterProxy failed ifFalse: - [self sqSocket: s ListenOnPort: port] -] + | addrSize addr s | -{ #category : #primitives } -SocketPlugin >> primitiveSocket: socket listenOnPort: port backlogSize: backlog [ - "second part of the wierdass dual prim primitiveSocketListenOnPort - which was warped by some demented evil person determined to twist the - very nature of reality" - | s okToListen | - - self primitive: 'primitiveSocketListenOnPortBacklog' parameters: #(#Oop #SmallInteger #SmallInteger ). - s := self socketValueOf: socket. + + - self sqSocket: s ListenOnPort: port BacklogSize: backlog -] + -{ #category : #primitives } -SocketPlugin >> primitiveSocket: socket listenOnPort: port backlogSize: backlog interface: ifAddr [ - "Bind a socket to the given port and interface address with no more than backlog pending connections. The socket can be UDP, in which case the backlog should be specified as zero." + self primitive: 'primitiveSocketListenOn' parameters: #(#Oop #Oop #SmallInteger). - | s okToListen addr | - - self primitive: 'primitiveSocketListenOnPortBacklogInterface' parameters: #(#Oop #SmallInteger #SmallInteger #ByteArray). s := self socketValueOf: socket. - addr := self netAddressToInt: (self cCoerce: ifAddr to: 'unsigned char *'). - self sqSocket: s ListenOnPort: port BacklogSize: backlog Interface: addr -] - -{ #category : #'ipv6 primitives' } -SocketPlugin >> primitiveSocket: socket listenWithBacklog: backlogSize [ + addr := self addressStructFor: socketAddressOop. + addrSize := self addressStructSizeFor: socketAddressOop. - | s | - - self primitive: 'primitiveSocketListenWithBacklog' parameters: #(#Oop #SmallInteger). - s := self socketValueOf: socket. - interpreterProxy failed ifFalse: [self sqSocket: s ListenBacklog: backlogSize] + interpreterProxy failed ifFalse: [ + self socketListenOn: s _: addr _: addrSize _: backlogSize. + self free: addr]. + + ] -{ #category : #'ipv6 primitives' } +{ #category : #'primitives - connection' } SocketPlugin >> primitiveSocket: socket localAddressResult: socketAddress [ | addrSize addrBase s | @@ -473,7 +560,7 @@ SocketPlugin >> primitiveSocket: socket localAddressResult: socketAddress [ interpreterProxy failed ifFalse: [self sqSocket: s LocalAddressResult: addrBase Size: addrSize] ] -{ #category : #primitives } +{ #category : #'primitives - sending/receiving' } SocketPlugin >> primitiveSocket: socket receiveDataBuf: array start: startIndex count: count [ | s byteSize arrayBase bufStart bytesReceived | @@ -501,7 +588,7 @@ SocketPlugin >> primitiveSocket: socket receiveDataBuf: array start: startIndex ^ (bytesReceived // byteSize) asSmallIntegerObj ] -{ #category : #primitives } +{ #category : #'primitives - sending/receiving' } SocketPlugin >> primitiveSocket: socket receiveUDPDataBuf: array start: startIndex count: count [ | s elementSize arrayBase bufStart bytesReceived results address port moreFlag | @@ -546,7 +633,7 @@ SocketPlugin >> primitiveSocket: socket receiveUDPDataBuf: array start: startInd ^ results ] -{ #category : #'ipv6 primitives' } +{ #category : #'primitives - connection' } SocketPlugin >> primitiveSocket: socket remoteAddressResult: socketAddress [ | addrSize addrBase s | @@ -559,7 +646,7 @@ SocketPlugin >> primitiveSocket: socket remoteAddressResult: socketAddress [ interpreterProxy failed ifFalse: [self sqSocket: s RemoteAddressResult: addrBase Size: addrSize] ] -{ #category : #primitives } +{ #category : #'primitives - sending/receiving' } SocketPlugin >> primitiveSocket: socket sendData: array start: startIndex count: count [ | s byteSize arrayBase bufStart bytesSent | @@ -587,7 +674,7 @@ SocketPlugin >> primitiveSocket: socket sendData: array start: startIndex count: ^ (bytesSent // byteSize) asSmallIntegerObj ] -{ #category : #primitives } +{ #category : #'primitives - sending/receiving' } SocketPlugin >> primitiveSocket: socket sendUDPData: array toHost: hostAddress port: portNumber start: startIndex count: count [ | s byteSize arrayBase bufStart bytesSent address | @@ -618,7 +705,7 @@ SocketPlugin >> primitiveSocket: socket sendUDPData: array toHost: hostAddress ^ (bytesSent // byteSize) asSmallIntegerObj ] -{ #category : #primitives } +{ #category : #'primitives - status' } SocketPlugin >> primitiveSocket: socket setOptions: optionName value: optionValue [ "THIS BADLY NEEDS TO BE REWRITTEN TO TAKE Booleans AND Integers AS WELL AS (OR INSTEAD OF) Strings. It is only used with booleans and integers and parsing these back out of strings in @@ -655,7 +742,7 @@ SocketPlugin >> primitiveSocket: socket setOptions: optionName value: optionValu ^ results ] -{ #category : #primitives } +{ #category : #'primitives - connection' } SocketPlugin >> primitiveSocketAbortConnection: socket [ | s | @@ -667,7 +754,7 @@ SocketPlugin >> primitiveSocketAbortConnection: socket [ self sqSocketAbortConnection: s] ] -{ #category : #primitives } +{ #category : #'primitives - creation' } SocketPlugin >> primitiveSocketAcceptFrom: sockHandle rcvBufferSize: recvBufSize sndBufSize: sendBufSize semaIndex: semaIndex readSemaIndex: aReadSema writeSemaIndex: aWriteSema [ | socketOop s serverSocket | @@ -690,7 +777,7 @@ SocketPlugin >> primitiveSocketAcceptFrom: sockHandle rcvBufferSize: recvBufSize ^ socketOop ] -{ #category : #'ipv6 primitives' } +{ #category : #'primitives - connection' } SocketPlugin >> primitiveSocketAddressGetPort [ | addr addrSize addrBase port | @@ -704,7 +791,7 @@ SocketPlugin >> primitiveSocketAddressGetPort [ interpreterProxy failed ifFalse: [^port asSmallIntegerObj]] ] -{ #category : #'ipv6 primitives' } +{ #category : #'primitives - connection' } SocketPlugin >> primitiveSocketAddressSetPort: portNumber [ | addr addrSize addrBase | @@ -715,7 +802,7 @@ SocketPlugin >> primitiveSocketAddressSetPort: portNumber [ interpreterProxy failed ifFalse: [self sqSocketAddress: addrBase Size: addrSize SetPort: portNumber] ] -{ #category : #primitives } +{ #category : #'primitives - connection' } SocketPlugin >> primitiveSocketCloseConnection: socket [ | s | @@ -727,7 +814,7 @@ SocketPlugin >> primitiveSocketCloseConnection: socket [ self sqSocketCloseConnection: s] ] -{ #category : #primitives } +{ #category : #'primitives - status' } SocketPlugin >> primitiveSocketConnectionStatus: socket [ | s status | @@ -740,7 +827,7 @@ SocketPlugin >> primitiveSocketConnectionStatus: socket [ ^ status asSmallIntegerObj ] -{ #category : #primitives } +{ #category : #'primitives - creation' } SocketPlugin >> primitiveSocketCreateNetwork: netType type: socketType receiveBufferSize: recvBufSize sendBufSize: sendBufSize semaIndex: semaIndex readSemaIndex: aReadSema writeSemaIndex: aWriteSema [ | socketOop s okToCreate | @@ -761,7 +848,7 @@ SocketPlugin >> primitiveSocketCreateNetwork: netType type: socketType receiveBu ^socketOop ] -{ #category : #primitives } +{ #category : #'primitives - creation' } SocketPlugin >> primitiveSocketCreateRaw: netType type: protoType receiveBufferSize: recvBufSize sendBufSize: sendBufSize semaIndex: semaIndex readSemaIndex: aReadSema writeSemaIndex: aWriteSema [ | socketOop s okToCreate | @@ -794,7 +881,7 @@ SocketPlugin >> primitiveSocketDestroy: socket [ self sqSocketDestroy: s] ] -{ #category : #primitives } +{ #category : #'primitives - status' } SocketPlugin >> primitiveSocketError: socket [ | s err | @@ -807,16 +894,6 @@ SocketPlugin >> primitiveSocketError: socket [ ^err asSmallIntegerObj ] -{ #category : #primitives } -SocketPlugin >> primitiveSocketListenWithOrWithoutBacklog [ - "Backward compatibility" - - interpreterProxy methodArgumentCount = 2 - ifTrue:[^self primitiveSocketListenOnPort] - ifFalse:[^self primitiveSocketListenOnPortBacklog] - -] - { #category : #primitives } SocketPlugin >> primitiveSocketLocalAddress: socket [ @@ -829,7 +906,7 @@ SocketPlugin >> primitiveSocketLocalAddress: socket [ ^self intToNetAddress: addr ] -{ #category : #'ipv6 primitives' } +{ #category : #'primitives - connection' } SocketPlugin >> primitiveSocketLocalAddressSize: socket [ | s size | @@ -854,7 +931,7 @@ SocketPlugin >> primitiveSocketLocalPort: socket [ ^port asSmallIntegerObj ] -{ #category : #primitives } +{ #category : #'primitives - sending/receiving' } SocketPlugin >> primitiveSocketReceiveDataAvailable: socket [ | s dataIsAvailable | @@ -878,7 +955,7 @@ SocketPlugin >> primitiveSocketRemoteAddress: socket [ ^self intToNetAddress: addr ] -{ #category : #'ipv6 primitives' } +{ #category : #'primitives - connection' } SocketPlugin >> primitiveSocketRemoteAddressSize: socket [ | s size | @@ -903,7 +980,7 @@ SocketPlugin >> primitiveSocketRemotePort: socket [ ^port asSmallIntegerObj ] -{ #category : #primitives } +{ #category : #'primitives - status' } SocketPlugin >> primitiveSocketSendDone: socket [ | s done | From 7d071e6d473826e90aee045693c6b5b63baa47de Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Thu, 9 Sep 2021 16:46:12 +0200 Subject: [PATCH 09/16] Adding the address in all the send/recv/connect messages --- plugins/SocketPlugin/include/SocketPlugin.h | 49 ++-- plugins/SocketPlugin/src/SocketPluginImpl.c | 282 ++++---------------- plugins/SocketPlugin/src/nameResolverImpl.c | 67 ++--- 3 files changed, 112 insertions(+), 286 deletions(-) diff --git a/plugins/SocketPlugin/include/SocketPlugin.h b/plugins/SocketPlugin/include/SocketPlugin.h index 252b98f6de..c0f2f72389 100644 --- a/plugins/SocketPlugin/include/SocketPlugin.h +++ b/plugins/SocketPlugin/include/SocketPlugin.h @@ -1,4 +1,4 @@ -/* squeak socket support header file */ +#pragma once /* module initialization/shutdown */ sqInt socketInit(void); @@ -40,8 +40,6 @@ sqInt sqSocketRemotePort(SocketPtr s); sqInt sqSocketSendDataBufCount(SocketPtr s, char *buf, sqInt bufSize); sqInt sqSocketSendDone(SocketPtr s); void sqSocketAcceptFromRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(SocketPtr s, SocketPtr serverSocket, sqInt recvBufSize, sqInt sendBufSize, sqInt semaIndex, sqInt readSemaIndex, sqInt writeSemaIndex); -sqInt sqSocketReceiveUDPDataBufCountaddressportmoreFlag(SocketPtr s, char *buf, sqInt bufSize, sqInt *address, sqInt *port, sqInt *moreFlag); -sqInt sqSockettoHostportSendDataBufCount(SocketPtr s, sqInt address, sqInt port, char *buf, sqInt bufSize); sqInt sqSocketSetOptionsoptionNameStartoptionNameSizeoptionValueStartoptionValueSizereturnedValue(SocketPtr s, char *optionName, sqInt optionNameSize, char *optionValue, sqInt optionValueSize, sqInt *result); sqInt sqSocketGetOptionsoptionNameStartoptionNameSizereturnedValue(SocketPtr s, char *optionName, sqInt optionNameSize, sqInt *result); void sqSocketSetReusable(SocketPtr s); @@ -55,9 +53,6 @@ sqInt sqResolverGetAddressInfoType(void); sqInt sqResolverGetAddressInfoProtocol(void); sqInt sqResolverGetAddressInfoNext(void); -sqInt sqSocketAddressSizeGetPort(char *addr, sqInt addrSize); -void sqSocketAddressSizeSetPort(char *addr, sqInt addrSize, sqInt port); - void sqResolverGetNameInfoSizeFlags(char *addr, sqInt addrSize, sqInt flags); sqInt sqResolverGetNameInfoHostSize(void); void sqResolverGetNameInfoHostResultSize(char *name, sqInt nameSize); @@ -67,22 +62,44 @@ void sqResolverGetNameInfoServiceResultSize(char *name, sqInt nameSize); sqInt sqResolverHostNameSize(void); void sqResolverHostNameResultSize(char *name, sqInt nameSize); -sqInt sqSocketLocalAddressSize(SocketPtr s); -void sqSocketLocalAddressResultSize(SocketPtr s, char *addr, int addrSize); -sqInt sqSocketRemoteAddressSize(SocketPtr s); -void sqSocketRemoteAddressResultSize(SocketPtr s, char *addr, int addrSize); - void socketConnectToAddressSize(SocketPtr s, void* addr, size_t addrSize); void socketListenOn(SocketPtr s, void* address, size_t addressSize, int backlogSize); void socketBindTo(SocketPtr s, void *address, size_t addrSize); +sqInt socketSendUDPDataToAddress(SocketPtr s, void* address, size_t addrSize, char* buffer, size_t bufferLength); +sqInt socketReceiveUDPData(SocketPtr s, char *buf, sqInt bufSize, void * address, size_t addrSize); void* newIP4SockAddr(int address, int port); size_t ip4SockSize(); +void setIp4Addressvalue(sqInt addressOop, sqInt address); +void setIp4Portvalue(sqInt addressOop, sqInt port); +void ip4UpdateAddress(sqInt addressOop, void* addr); + + /* family */ -#define SQ_SOCKET_FAMILY_UNSPECIFIED 0 -#define SQ_SOCKET_FAMILY_LOCAL 1 -#define SQ_SOCKET_FAMILY_INET4 2 -#define SQ_SOCKET_FAMILY_INET6 3 -#define SQ_SOCKET_FAMILY_MAX 4 +#define SOCKET_FAMILY_UNSPECIFIED 0 +#define SOCKET_FAMILY_LOCAL 1 +#define SOCKET_FAMILY_INET4 2 +#define SOCKET_FAMILY_INET6 3 +#define SOCKET_FAMILY_MAX 4 + +/* flags */ + +#define SOCKET_NUMERIC (1<<0) +#define SOCKET_PASSIVE (1<<1) + +/* type */ + +#define SOCKET_TYPE_UNSPECIFIED 0 +#define SOCKET_TYPE_STREAM 1 +#define SOCKET_TYPE_DGRAM 2 +#define SOCKET_TYPE_MAX 3 + +/* protocol */ + +#define SOCKET_PROTOCOL_UNSPECIFIED 0 +#define SOCKET_PROTOCOL_TCP 1 +#define SOCKET_PROTOCOL_UDP 2 +#define SOCKET_PROTOCOL_MAX 3 + diff --git a/plugins/SocketPlugin/src/SocketPluginImpl.c b/plugins/SocketPlugin/src/SocketPluginImpl.c index 7891d67ab0..aef32bf3e9 100644 --- a/plugins/SocketPlugin/src/SocketPluginImpl.c +++ b/plugins/SocketPlugin/src/SocketPluginImpl.c @@ -451,10 +451,10 @@ void sqSocketCreateNetTypeSocketTypeRecvBytesSendBytesSemaIDReadSemaIDWriteSemaI switch (domain) { - case 0: domain= AF_INET; break; /* SQ_SOCKET_DOMAIN_UNSPECIFIED */ - case 1: domain= AF_UNIX; break; /* SQ_SOCKET_DOMAIN_LOCAL */ - case 2: domain= AF_INET; break; /* SQ_SOCKET_DOMAIN_INET4 */ - case 3: domain= AF_INET6; break; /* SQ_SOCKET_DOMAIN_INET6 */ + case SOCKET_FAMILY_UNSPECIFIED: domain= AF_INET; break; + case SOCKET_FAMILY_LOCAL: domain= AF_UNIX; break; + case SOCKET_FAMILY_INET4: domain = AF_INET; break; + case SOCKET_FAMILY_INET6: domain = AF_INET6; break; } s->sessionID= 0; @@ -1010,71 +1010,6 @@ sqInt sqSocketSendDataBufCount(SocketPtr s, char *buf, sqInt bufSize) } -/* read data from the UDP socket s into buf for at most bufSize bytes. - answer the number of bytes actually read. -*/ -sqInt sqSocketReceiveUDPDataBufCountaddressportmoreFlag(SocketPtr s, char *buf, sqInt bufSize, sqInt *address, sqInt *port, sqInt *moreFlag) -{ - int lastError; - if (socketValid(s) && (TCPSocketType != s->socketType)) /* --- UDP/RAW --- */ - { - struct sockaddr_in saddr; - socklen_t addrSize= sizeof(saddr); - - logTrace( "recvFrom(%d)\n", SOCKET(s)); - memset(&saddr, 0, sizeof(saddr)); - { - int nread= recvfrom(SOCKET(s), buf, bufSize, 0, (struct sockaddr *)&saddr, &addrSize); - if (nread >= 0) - { - *address= ntohl(saddr.sin_addr.s_addr); - *port= ntohs(saddr.sin_port); - return nread; - } - lastError = getLastSocketError(); - if (lastError == ERROR_WOULD_BLOCK) /* asynchronous read in progress */ - return 0; - SOCKETERROR(s)= lastError; - logTrace("receiveData(%d)= %da\n", SOCKET(s), 0); - } - } - success(false); - return 0; -} - - -/* write data to the UDP socket s from buf for at most bufSize bytes. - * answer the number of bytes actually written. - */ -sqInt sqSockettoHostportSendDataBufCount(SocketPtr s, sqInt address, sqInt port, char *buf, sqInt bufSize) -{ - if (socketValid(s) && (TCPSocketType != s->socketType)) - { - struct sockaddr_in saddr; - - logTrace( "sendTo(%d)\n", SOCKET(s)); - memset(&saddr, 0, sizeof(saddr)); - saddr.sin_family= AF_INET; - saddr.sin_port= htons((short)port); - saddr.sin_addr.s_addr= htonl(address); - { - int nsent= sendto(SOCKET(s), buf, bufSize, 0, (struct sockaddr *)&saddr, sizeof(saddr)); - if (nsent >= 0) - return nsent; - - int lastError = getLastSocketError(); - - if (lastError == ERROR_WOULD_BLOCK) /* asynchronous write in progress */ - return 0; - logTrace( "UDP send failed\n"); - SOCKETERROR(s)= lastError; - } - } - success(false); - return 0; -} - - /*** socket options ***/ @@ -1266,36 +1201,6 @@ void sqSocketSetReusable(SocketPtr s) } } -/* ---- address manipulation ---- */ - - -sqInt sqSocketAddressSizeGetPort(char *addr, sqInt addrSize) -{ - if (addressValid(addr, addrSize)) - switch (socketAddress(addr)->sa_family) - { - case AF_INET: return ntohs(((struct sockaddr_in *)socketAddress(addr))->sin_port); - case AF_INET6: return ntohs(((struct sockaddr_in6 *)socketAddress(addr))->sin6_port); - } - - success(false); - return 0; -} - - -void sqSocketAddressSizeSetPort(char *addr, sqInt addrSize, sqInt port) -{ - if (addressValid(addr, addrSize)) - switch (socketAddress(addr)->sa_family) - { - case AF_INET: ((struct sockaddr_in *)socketAddress(addr))->sin_port= htons(port); return; - case AF_INET6: ((struct sockaddr_in6 *)socketAddress(addr))->sin6_port= htons(port); return; - } - - success(false); -} - - void socketBindTo(SocketPtr s, void *address, size_t addrSize) { struct sockaddr* addr = (struct sockaddr*) address; @@ -1380,162 +1285,85 @@ void socketConnectToAddressSize(SocketPtr s, void* address, size_t addrSize){ } } -void* newIP4SockAddr(int address, int port) { - struct sockaddr_in* r = (struct sockaddr_in*) malloc(sizeof(struct sockaddr_in)); +sqInt socketSendUDPDataToAddress(SocketPtr s, void* address, size_t addrSize, char* buffer, size_t bufferLength) { - memset(r, 0, sizeof(struct sockaddr_in)); + struct sockaddr* addr = (struct sockaddr*)address; - r->sin_family = AF_INET; - r->sin_port = htons((short)port); - r->sin_addr.s_addr = htonl(address); + if (socketValid(s) && (TCPSocketType != s->socketType)) { - return r; -} + logTrace("sendTo(%d)\n", SOCKET(s)); -size_t ip4SockSize(){ - return sizeof(struct sockaddr_in); -} + int nsent = sendto(SOCKET(s), buffer, bufferLength, 0, addr, addrSize); + if (nsent >= 0) + return nsent; -sqInt sqSocketLocalAddressSize(SocketPtr s) -{ - union sockaddr_any saddr; - socklen_t saddrSize= sizeof(saddr); + int lastError = getLastSocketError(); - if (!socketValid(s)) - return -1; + if (lastError == ERROR_WOULD_BLOCK) /* asynchronous write in progress */ + return 0; - if (getsockname(SOCKET(s), &saddr.sa, &saddrSize)) - return 0; + logTrace("UDP send failed\n"); + SOCKETERROR(s) = lastError; + } - return AddressHeaderSize + saddrSize; + success(false); + return 0; } +sqInt socketReceiveUDPData(SocketPtr s, char *buf, sqInt bufSize, void * address, size_t addrSize) { + int lastError; + struct sockaddr* saddr = (struct sockaddr*) address; + socklen_t saddrSize = addrSize; -void sqSocketLocalAddressResultSize(SocketPtr s, char *addr, int addrSize) -{ - union sockaddr_any saddr; - socklen_t saddrSize= sizeof(saddr); - - if (!socketValid(s)) - goto fail; + if (socketValid(s) && (TCPSocketType != s->socketType)) /* --- UDP/RAW --- */ + { + logTrace("recvFrom(%d)\n", SOCKET(s)); - if (getsockname(SOCKET(s), &saddr.sa, &saddrSize)) - goto fail; + int nread = recvfrom(SOCKET(s), buf, bufSize, 0, saddr, &saddrSize); - if (addrSize != (AddressHeaderSize + saddrSize)) - goto fail; + if (nread >= 0) { + return nread; + } - addressHeader(addr)->sessionID= getNetSessionID(); + lastError = getLastSocketError(); - addressHeader(addr)->size= saddrSize; - memcpy(socketAddress(addr), &saddr.sa, saddrSize); - return; + if (lastError == ERROR_WOULD_BLOCK) /* asynchronous read in progress */ + return 0; - fail: - success(false); - return; + SOCKETERROR(s) = lastError; + logTrace("receiveData(%d)= %da\n", SOCKET(s), 0); + } + success(false); + return 0; } -sqInt sqSocketRemoteAddressSize(SocketPtr s) -{ - union sockaddr_any saddr; - socklen_t saddrSize= sizeof(saddr); +void* newIP4SockAddr(int address, int port) { + struct sockaddr_in* r = (struct sockaddr_in*) malloc(sizeof(struct sockaddr_in)); - if (!socketValid(s)) - return -1; + memset(r, 0, sizeof(struct sockaddr_in)); - if (TCPSocketType == s->socketType) /* --- TCP --- */ - { - if (0 == getpeername(SOCKET(s), &saddr.sa, &saddrSize)) - { - if (saddrSize < sizeof(SOCKETPEER(s))) - { - memcpy(&SOCKETPEER(s), &saddr.sa, saddrSize); - return AddressHeaderSize + (SOCKETPEERSIZE(s)= saddrSize); - } - } - } - else if (SOCKETPEERSIZE(s)) /* --- UDP/RAW --- */ - { - return AddressHeaderSize + SOCKETPEERSIZE(s); - } + r->sin_family = AF_INET; + r->sin_port = htons((short)port); + r->sin_addr.s_addr = htonl(address); - return -1; + return r; } - -void sqSocketRemoteAddressResultSize(SocketPtr s, char *addr, int addrSize) -{ - if (!socketValid(s) - || !SOCKETPEERSIZE(s) - || (addrSize != (AddressHeaderSize + SOCKETPEERSIZE(s)))) { - success(false); - return; - } - - addressHeader(addr)->sessionID= getNetSessionID(); - - addressHeader(addr)->size= SOCKETPEERSIZE(s); - memcpy(socketAddress(addr), &SOCKETPEER(s), SOCKETPEERSIZE(s)); - SOCKETPEERSIZE(s)= 0; +size_t ip4SockSize(){ + return sizeof(struct sockaddr_in); } +void ip4UpdateAddress(sqInt addressOop, void* addr){ + struct sockaddr_in* address = (struct sockaddr_in*)addr; -/* ---- communication ---- */ - - -sqInt sqSocketSendUDPToSizeDataBufCount(SocketPtr s, char *addr, sqInt addrSize, char *buf, sqInt bufSize) -{ - logTrace( "sendTo(%d)\n", SOCKET(s)); - if (socketValid(s) && addressValid(addr, addrSize) && (TCPSocketType != s->socketType)) /* --- UDP/RAW --- */ - { - int nsent= sendto(SOCKET(s), buf, bufSize, 0, socketAddress(addr), addrSize - AddressHeaderSize); - if (nsent >= 0) - return nsent; - - int lastError = getLastSocketError(); - - if (lastError == ERROR_WOULD_BLOCK) /* asynchronous write in progress */ - return 0; - - logTrace("UDP send failed\n"); - SOCKETERROR(s)= lastError; - } + if(address->sin_family != AF_INET){ + success(false); + return; + } - success(false); - return 0; + setIp4Addressvalue(addressOop, ntohl(address->sin_addr.s_addr)); + setIp4Portvalue(addressOop, ntohs(address->sin_port)); } - -sqInt sqSocketReceiveUDPDataBufCount(SocketPtr s, char *buf, sqInt bufSize) { - int lastError; - - logTrace("recvFrom(%d)\n", SOCKET(s)); - if (socketValid(s) && (TCPSocketType != s->socketType)) { - - /* --- UDP/RAW --- */ - - socklen_t saddrSize = sizeof(SOCKETPEER(s)); - - int nread = recvfrom(SOCKET(s), buf, bufSize, 0, &SOCKETPEER(s).sa, - &saddrSize); - - lastError = getLastSocketError(); - - if (nread >= 0) { - SOCKETPEERSIZE(s) = saddrSize; - return nread; - } - - SOCKETPEERSIZE(s) = 0; - if (lastError == ERROR_WOULD_BLOCK) /* asynchronous read in progress */ - return 0; - - SOCKETERROR(s) = lastError; - logTrace("receiveData(%d)= %da\n", SOCKET(s), 0); - } - success(false); - return 0; -} diff --git a/plugins/SocketPlugin/src/nameResolverImpl.c b/plugins/SocketPlugin/src/nameResolverImpl.c index 40e343a69c..ae41f8648b 100644 --- a/plugins/SocketPlugin/src/nameResolverImpl.c +++ b/plugins/SocketPlugin/src/nameResolverImpl.c @@ -28,25 +28,6 @@ static struct addrinfo *addrList= 0; static struct addrinfo *addrInfo= 0; static struct addrinfo *localInfo= 0; -/* flags */ - -#define SQ_SOCKET_NUMERIC (1<<0) -#define SQ_SOCKET_PASSIVE (1<<1) - -/* type */ - -#define SQ_SOCKET_TYPE_UNSPECIFIED 0 -#define SQ_SOCKET_TYPE_STREAM 1 -#define SQ_SOCKET_TYPE_DGRAM 2 -#define SQ_SOCKET_TYPE_MAX 3 - -/* protocol */ - -#define SQ_SOCKET_PROTOCOL_UNSPECIFIED 0 -#define SQ_SOCKET_PROTOCOL_TCP 1 -#define SQ_SOCKET_PROTOCOL_UDP 2 -#define SQ_SOCKET_PROTOCOL_MAX 3 - /* answer the hostname for the given IP address */ static const char *addrToName(int netAddress) @@ -287,9 +268,9 @@ void sqResolverGetAddressInfoHostSizeServiceSizeFlagsFamilyTypeProtocol(char *ho if ((!getNetSessionID()) || (hostSize < 0) || (hostSize > MAXHOSTNAMELEN) || (servSize < 0) || (servSize > MAXHOSTNAMELEN) - || (family < 0) || (family >= SQ_SOCKET_FAMILY_MAX) - || (type < 0) || (type >= SQ_SOCKET_TYPE_MAX) - || (protocol < 0) || (protocol >= SQ_SOCKET_PROTOCOL_MAX)) + || (family < 0) || (family >= SOCKET_FAMILY_MAX) + || (type < 0) || (type >= SOCKET_TYPE_MAX) + || (protocol < 0) || (protocol >= SOCKET_PROTOCOL_MAX)) goto fail; if (hostSize) @@ -302,7 +283,7 @@ void sqResolverGetAddressInfoHostSizeServiceSizeFlagsFamilyTypeProtocol(char *ho logTrace( " -> GetAddressInfo %s %s\n", host, serv); - if (servSize && (family == SQ_SOCKET_FAMILY_LOCAL) && (servSize < sizeof(((struct sockaddr_un *)0)->sun_path)) && !(flags & SQ_SOCKET_NUMERIC)) + if (servSize && (family == SOCKET_FAMILY_LOCAL) && (servSize < sizeof(((struct sockaddr_un *)0)->sun_path)) && !(flags & SOCKET_NUMERIC)) { struct stat st; if ((0 == stat(servName, &st)) && (st.st_mode & S_IFSOCK)) @@ -325,26 +306,26 @@ void sqResolverGetAddressInfoHostSizeServiceSizeFlagsFamilyTypeProtocol(char *ho memset(&request, 0, sizeof(request)); - if (flags & SQ_SOCKET_NUMERIC) request.ai_flags |= AI_NUMERICHOST; - if (flags & SQ_SOCKET_PASSIVE) request.ai_flags |= AI_PASSIVE; + if (flags & SOCKET_NUMERIC) request.ai_flags |= AI_NUMERICHOST; + if (flags & SOCKET_PASSIVE) request.ai_flags |= AI_PASSIVE; switch (family) { - case SQ_SOCKET_FAMILY_LOCAL: request.ai_family= AF_UNIX; break; - case SQ_SOCKET_FAMILY_INET4: request.ai_family= AF_INET; break; - case SQ_SOCKET_FAMILY_INET6: request.ai_family= AF_INET6; break; + case SOCKET_FAMILY_LOCAL: request.ai_family= AF_UNIX; break; + case SOCKET_FAMILY_INET4: request.ai_family= AF_INET; break; + case SOCKET_FAMILY_INET6: request.ai_family= AF_INET6; break; } switch (type) { - case SQ_SOCKET_TYPE_STREAM: request.ai_socktype= SOCK_STREAM; break; - case SQ_SOCKET_TYPE_DGRAM: request.ai_socktype= SOCK_DGRAM; break; + case SOCKET_TYPE_STREAM: request.ai_socktype= SOCK_STREAM; break; + case SOCKET_TYPE_DGRAM: request.ai_socktype= SOCK_DGRAM; break; } switch (protocol) { - case SQ_SOCKET_PROTOCOL_TCP: request.ai_protocol= IPPROTO_TCP; break; - case SQ_SOCKET_PROTOCOL_UDP: request.ai_protocol= IPPROTO_UDP; break; + case SOCKET_PROTOCOL_TCP: request.ai_protocol= IPPROTO_TCP; break; + case SOCKET_PROTOCOL_UDP: request.ai_protocol= IPPROTO_UDP; break; } gaiError= getaddrinfo(hostSize ? host : 0, servSize ? serv : 0, &request, &addrList); @@ -386,12 +367,12 @@ sqInt sqResolverGetAddressInfoFamily(void) switch (addrInfo->ai_family) { - case AF_UNIX: return SQ_SOCKET_FAMILY_LOCAL; - case AF_INET: return SQ_SOCKET_FAMILY_INET4; - case AF_INET6: return SQ_SOCKET_FAMILY_INET6; + case AF_UNIX: return SOCKET_FAMILY_LOCAL; + case AF_INET: return SOCKET_FAMILY_INET4; + case AF_INET6: return SOCKET_FAMILY_INET6; } - return SQ_SOCKET_FAMILY_UNSPECIFIED; + return SOCKET_FAMILY_UNSPECIFIED; } @@ -405,11 +386,11 @@ sqInt sqResolverGetAddressInfoType(void) switch (addrInfo->ai_socktype) { - case SOCK_STREAM: return SQ_SOCKET_TYPE_STREAM; - case SOCK_DGRAM: return SQ_SOCKET_TYPE_DGRAM; + case SOCK_STREAM: return SOCKET_TYPE_STREAM; + case SOCK_DGRAM: return SOCKET_TYPE_DGRAM; } - return SQ_SOCKET_TYPE_UNSPECIFIED; + return SOCKET_TYPE_UNSPECIFIED; } @@ -423,11 +404,11 @@ sqInt sqResolverGetAddressInfoProtocol(void) switch (addrInfo->ai_protocol) { - case IPPROTO_TCP: return SQ_SOCKET_PROTOCOL_TCP; - case IPPROTO_UDP: return SQ_SOCKET_PROTOCOL_UDP; + case IPPROTO_TCP: return SOCKET_PROTOCOL_TCP; + case IPPROTO_UDP: return SOCKET_PROTOCOL_UDP; } - return SQ_SOCKET_PROTOCOL_UNSPECIFIED; + return SOCKET_PROTOCOL_UNSPECIFIED; } @@ -451,7 +432,7 @@ void sqResolverGetNameInfoSizeFlags(char *addr, sqInt addrSize, sqInt flags) niFlags |= NI_NOFQDN; - if (flags & SQ_SOCKET_NUMERIC) niFlags |= (NI_NUMERICHOST | NI_NUMERICSERV); + if (flags & SOCKET_NUMERIC) niFlags |= (NI_NUMERICHOST | NI_NUMERICSERV); /*dumpAddr(socketAddress(addr), addrSize - AddressHeaderSize); logTrace("%02x\n", niFlags);*/ From 6e3065fc7348b8ed292927c78bc32c58f3c3990b Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Thu, 9 Sep 2021 16:48:41 +0200 Subject: [PATCH 10/16] Cleaning up and improving SocketPlugin --- smalltalksrc/VMMaker/SocketPlugin.class.st | 204 +++++++++------------ 1 file changed, 88 insertions(+), 116 deletions(-) diff --git a/smalltalksrc/VMMaker/SocketPlugin.class.st b/smalltalksrc/VMMaker/SocketPlugin.class.st index 41cb611a63..452ddf9980 100644 --- a/smalltalksrc/VMMaker/SocketPlugin.class.st +++ b/smalltalksrc/VMMaker/SocketPlugin.class.st @@ -29,6 +29,12 @@ SocketPlugin class >> requiresPlatformFiles [ ^true ] +{ #category : #translation } +SocketPlugin class >> shouldGenerateDeadCode [ + + ^ false +] + { #category : #'accessing - ip4' } SocketPlugin >> addressStructFor: aSocketAddress [ @@ -143,7 +149,7 @@ SocketPlugin >> intToNetAddress: addr [ { #category : #'accessing - ip4' } SocketPlugin >> ip4AddressType [ - + ^ 2 ] @@ -547,19 +553,6 @@ SocketPlugin >> primitiveSocket: socket listenOn: socketAddressOop backLog: back ] -{ #category : #'primitives - connection' } -SocketPlugin >> primitiveSocket: socket localAddressResult: socketAddress [ - - | addrSize addrBase s | - - - self primitive: 'primitiveSocketLocalAddressResult' parameters: #(#Oop #Oop). - s := self socketValueOf: socket. - addrSize := interpreterProxy byteSizeOf: socketAddress. - addrBase := self cCoerce: (interpreterProxy firstIndexableField: socketAddress) to: 'char *'. - interpreterProxy failed ifFalse: [self sqSocket: s LocalAddressResult: addrBase Size: addrSize] -] - { #category : #'primitives - sending/receiving' } SocketPlugin >> primitiveSocket: socket receiveDataBuf: array start: startIndex count: count [ | s byteSize arrayBase bufStart bytesReceived | @@ -589,13 +582,17 @@ SocketPlugin >> primitiveSocket: socket receiveDataBuf: array start: startIndex ] { #category : #'primitives - sending/receiving' } -SocketPlugin >> primitiveSocket: socket receiveUDPDataBuf: array start: startIndex count: count [ - | s elementSize arrayBase bufStart bytesReceived results address port moreFlag | +SocketPlugin >> primitiveSocket: socket receiveUDPDataBuf: array start: startIndex count: count fromAddress: socketAddressOop [ + | s elementSize arrayBase bufStart bytesReceived addr addrSize | - self primitive: 'primitiveSocketReceiveUDPDataBufCount' - parameters: #(Oop Oop SmallInteger SmallInteger). + + + + self primitive: 'primitiveSocketReceiveUDPData' + parameters: #(Oop Oop SmallInteger SmallInteger Oop). + s := self socketValueOf: socket. "buffer can be any indexable words or bytes object" @@ -605,45 +602,24 @@ SocketPlugin >> primitiveSocket: socket receiveUDPDataBuf: array start: startInd ifFalse: [elementSize := 1]. interpreterProxy success: (startIndex >= 1 and: [count >= 0 and: [startIndex + count - 1 <= (interpreterProxy slotSizeOf: array)]]). + + addr := self addressStructFor: socketAddressOop. + addrSize := self addressStructSizeFor: socketAddressOop. + interpreterProxy failed ifFalse: ["Note: adjust bufStart for zero-origin indexing" arrayBase := self cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *'. bufStart := arrayBase + (startIndex - 1 * elementSize). - address := 0. - port := 0. - moreFlag := 0. - bytesReceived := self sqSocket: s - ReceiveUDPDataBuf: bufStart - Count: count * elementSize - address: (self addressOf: address) - port: (self addressOf: port) - moreFlag: (self addressOf: moreFlag). - - "allocate storage for results, remapping newly allocated - oops in case GC happens during allocation" - interpreterProxy pushRemappableOop: (self intToNetAddress: address). - results := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 4. - interpreterProxy storePointer: 0 ofObject: results withValue: (bytesReceived // elementSize) asSmallIntegerObj. - interpreterProxy storePointer: 1 ofObject: results withValue: interpreterProxy popRemappableOop. - interpreterProxy storePointer: 2 ofObject: results withValue: port asSmallIntegerObj. - interpreterProxy storePointer: 3 ofObject: results withValue: (moreFlag - ifTrue: [interpreterProxy trueObject] - ifFalse: [interpreterProxy falseObject]). - ]. - ^ results -] - -{ #category : #'primitives - connection' } -SocketPlugin >> primitiveSocket: socket remoteAddressResult: socketAddress [ - - | addrSize addrBase s | - - - self primitive: 'primitiveSocketRemoteAddressResult' parameters: #(#Oop #Oop). - s := self socketValueOf: socket. - addrSize := interpreterProxy byteSizeOf: socketAddress. - addrBase := self cCoerce: (interpreterProxy firstIndexableField: socketAddress) to: 'char *'. - interpreterProxy failed ifFalse: [self sqSocket: s RemoteAddressResult: addrBase Size: addrSize] + bytesReceived := self socketReceiveUDPData: s + _: bufStart + _: count * elementSize + _: addr + _: addrSize. + + self updateAddress: socketAddressOop from: addr. + self free: addr ]. + + ^ (bytesReceived // elementSize) asSmallIntegerObj ] { #category : #'primitives - sending/receiving' } @@ -675,13 +651,13 @@ SocketPlugin >> primitiveSocket: socket sendData: array start: startIndex count: ] { #category : #'primitives - sending/receiving' } -SocketPlugin >> primitiveSocket: socket sendUDPData: array toHost: hostAddress port: portNumber start: startIndex count: count [ - | s byteSize arrayBase bufStart bytesSent address | +SocketPlugin >> primitiveSocket: socket sendUDPData: array toAddress: socketAddressOop start: startIndex count: count [ + | s byteSize arrayBase bufStart bytesSent addr addrSize | - - self primitive: 'primitiveSocketSendUDPDataBufCount' - parameters: #(Oop Oop ByteArray SmallInteger SmallInteger SmallInteger ). + + self primitive: 'primitiveSocketSendUDPData' parameters: #(Oop Oop Oop SmallInteger SmallInteger ). + s := self socketValueOf: socket. "buffer can be any indexable words or bytes object except CompiledMethod " @@ -689,19 +665,21 @@ SocketPlugin >> primitiveSocket: socket sendUDPData: array toHost: hostAddress (interpreterProxy isWords: array) ifTrue: [byteSize := 4] ifFalse: [byteSize := 1]. + interpreterProxy success: (startIndex >= 1 and: [count >= 0 and: [startIndex + count - 1 <= (interpreterProxy slotSizeOf: array)]]). + interpreterProxy failed ifFalse: ["Note: adjust bufStart for zero-origin indexing" arrayBase := self cCoerce: (interpreterProxy firstIndexableField: array) to: 'char *'. bufStart := arrayBase + (startIndex - 1 * byteSize). - address := self netAddressToInt: (self cCoerce: hostAddress to: 'unsigned char *'). - bytesSent := self - sqSocket: s - toHost: address - port: portNumber - SendDataBuf: bufStart - Count: count * byteSize]. + addr := self addressStructFor: socketAddressOop. + addrSize := self addressStructSizeFor: socketAddressOop. + + bytesSent := self socketSendUDPDataToAddress: s _: addr _: addrSize _: bufStart _: count * byteSize. + self free: addr]. + + ^ (bytesSent // byteSize) asSmallIntegerObj ] @@ -777,31 +755,6 @@ SocketPlugin >> primitiveSocketAcceptFrom: sockHandle rcvBufferSize: recvBufSize ^ socketOop ] -{ #category : #'primitives - connection' } -SocketPlugin >> primitiveSocketAddressGetPort [ - - | addr addrSize addrBase port | - - addr := self primitive: 'primitiveSocketAddressGetPort' parameters: #() receiver: #Oop. - addrSize := interpreterProxy byteSizeOf: addr. - addrBase := self cCoerce: (interpreterProxy firstIndexableField: addr) to: 'char *'. - interpreterProxy failed - ifFalse: - [port := self sqSocketAddress: addrBase SizeGetPort: addrSize. - interpreterProxy failed ifFalse: [^port asSmallIntegerObj]] -] - -{ #category : #'primitives - connection' } -SocketPlugin >> primitiveSocketAddressSetPort: portNumber [ - - | addr addrSize addrBase | - - addr := self primitive: 'primitiveSocketAddressSetPort' parameters: #(SmallInteger) receiver: #Oop. - addrSize := interpreterProxy byteSizeOf: addr. - addrBase := self cCoerce: (interpreterProxy firstIndexableField: addr) to: 'char *'. - interpreterProxy failed ifFalse: [self sqSocketAddress: addrBase Size: addrSize SetPort: portNumber] -] - { #category : #'primitives - connection' } SocketPlugin >> primitiveSocketCloseConnection: socket [ @@ -906,19 +859,6 @@ SocketPlugin >> primitiveSocketLocalAddress: socket [ ^self intToNetAddress: addr ] -{ #category : #'primitives - connection' } -SocketPlugin >> primitiveSocketLocalAddressSize: socket [ - - | s size | - - self primitive: 'primitiveSocketLocalAddressSize' parameters: #(#Oop). - s := self socketValueOf: socket. - interpreterProxy failed ifTrue: [^nil]. - size := self sqSocketLocalAddressSize: s. - interpreterProxy failed ifTrue: [^nil]. - ^size asSmallIntegerObj -] - { #category : #primitives } SocketPlugin >> primitiveSocketLocalPort: socket [ @@ -955,19 +895,6 @@ SocketPlugin >> primitiveSocketRemoteAddress: socket [ ^self intToNetAddress: addr ] -{ #category : #'primitives - connection' } -SocketPlugin >> primitiveSocketRemoteAddressSize: socket [ - - | s size | - - self primitive: 'primitiveSocketRemoteAddressSize' parameters: #(#Oop). - s := self socketValueOf: socket. - interpreterProxy failed ifTrue: [^nil]. - size := self sqSocketRemoteAddressSize: s. - interpreterProxy failed ifTrue: [^nil]. - ^size asSmallIntegerObj -] - { #category : #primitives } SocketPlugin >> primitiveSocketRemotePort: socket [ @@ -992,6 +919,34 @@ SocketPlugin >> primitiveSocketSendDone: socket [ ^done asBooleanObj ] +{ #category : #'accessing - ip4' } +SocketPlugin >> setIp4Address: anAddressOop value: addr [ + + + + + + | naPtr | + naPtr := interpreterProxy firstIndexableField: (interpreterProxy fetchPointer: 1 ofObject: anAddressOop). + naPtr at: 0 put: (self cCoerce: ((addr >> 24) bitAnd: 16rFF) to: 'char'). + naPtr at: 1 put: (self cCoerce: ((addr >> 16) bitAnd: 16rFF) to: 'char'). + naPtr at: 2 put: (self cCoerce: ((addr >> 8) bitAnd: 16rFF) to: 'char'). + naPtr at: 3 put: (self cCoerce: (addr bitAnd: 16rFF) to: 'char'). + +] + +{ #category : #'accessing - ip4' } +SocketPlugin >> setIp4Port: anAddressOop value: aPort [ + + + + + "IPv4 Addresses are represented by an object with a smallinteger saying the address type (2 for IPv4), a 4 bytes bytearray as second instance variable, and a smallInteger as port number as third instance variable. If it does not have port the value is -1." + + ^ interpreterProxy storeInteger: 2 ofObject: anAddressOop withValue: aPort + +] + { #category : #'initialize-release' } SocketPlugin >> shutdownModule [ @@ -1015,3 +970,20 @@ SocketPlugin >> socketValueOf: socketOop [ ifTrue: [self cCoerce: (interpreterProxy firstIndexableField: socketOop) to: #SocketPtr] ifFalse: [interpreterProxy primitiveFailFor: PrimErrBadArgument. nil] ] + +{ #category : #'accessing - ip4' } +SocketPlugin >> updateAddress: socketAddressOop from: addr [ + + + + + | addressType | + + addressType := self getAddressType: socketAddressOop. + interpreterProxy failed ifTrue: [ ^ nil ]. + + addressType = self ip4AddressType + ifTrue: [ ^ self ip4UpdateAddress: socketAddressOop _: addr ]. + + ^ interpreterProxy primitiveFail. +] From 724caf885eaeaea5d3625a3832f7391d498e38b7 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Fri, 10 Sep 2021 15:40:13 +0200 Subject: [PATCH 11/16] Changing resolution of remote and local addresses --- plugins/SocketPlugin/include/SocketPlugin.h | 12 +- plugins/SocketPlugin/src/SocketPluginImpl.c | 192 ++++++++++++-------- 2 files changed, 122 insertions(+), 82 deletions(-) diff --git a/plugins/SocketPlugin/include/SocketPlugin.h b/plugins/SocketPlugin/include/SocketPlugin.h index c0f2f72389..e866bacca8 100644 --- a/plugins/SocketPlugin/include/SocketPlugin.h +++ b/plugins/SocketPlugin/include/SocketPlugin.h @@ -23,20 +23,16 @@ sqInt sqResolverNameLookupResult(void); void sqResolverStartAddrLookup(sqInt address); void sqResolverStartNameLookup(char *hostName, sqInt nameSize); sqInt sqResolverStatus(void); + void sqSocketAbortConnection(SocketPtr s); void sqSocketCloseConnection(SocketPtr s); sqInt sqSocketConnectionStatus(SocketPtr s); -void sqSocketConnectToPort(SocketPtr s, sqInt addr, sqInt port); void sqSocketCreateNetTypeSocketTypeRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(SocketPtr s, sqInt netType, sqInt socketType, sqInt recvBufSize, sqInt sendBufSize, sqInt semaIndex, sqInt readSemaIndex, sqInt writeSemaIndex); void sqSocketCreateRawProtoTypeRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(SocketPtr s, sqInt domain, sqInt protocol, sqInt recvBufSize, sqInt sendBufSize, sqInt semaIndex, sqInt readSemaIndex, sqInt writeSemaIndex); void sqSocketDestroy(SocketPtr s); sqInt sqSocketError(SocketPtr s); -sqInt sqSocketLocalAddress(SocketPtr s); -sqInt sqSocketLocalPort(SocketPtr s); sqInt sqSocketReceiveDataAvailable(SocketPtr s); sqInt sqSocketReceiveDataBufCount(SocketPtr s, char *buf, sqInt bufSize); -sqInt sqSocketRemoteAddress(SocketPtr s); -sqInt sqSocketRemotePort(SocketPtr s); sqInt sqSocketSendDataBufCount(SocketPtr s, char *buf, sqInt bufSize); sqInt sqSocketSendDone(SocketPtr s); void sqSocketAcceptFromRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(SocketPtr s, SocketPtr serverSocket, sqInt recvBufSize, sqInt sendBufSize, sqInt semaIndex, sqInt readSemaIndex, sqInt writeSemaIndex); @@ -68,6 +64,12 @@ void socketBindTo(SocketPtr s, void *address, size_t addrSize); sqInt socketSendUDPDataToAddress(SocketPtr s, void* address, size_t addrSize, char* buffer, size_t bufferLength); sqInt socketReceiveUDPData(SocketPtr s, char *buf, sqInt bufSize, void * address, size_t addrSize); +void socketLocalAddress(SocketPtr s, void* addr, size_t addrSize); +sqInt socketLocalAddressType(SocketPtr s); + +void socketRemoteAddress(SocketPtr s, void* addr, size_t addrSize); +sqInt socketRemoteAddressType(SocketPtr s); + void* newIP4SockAddr(int address, int port); size_t ip4SockSize(); diff --git a/plugins/SocketPlugin/src/SocketPluginImpl.c b/plugins/SocketPlugin/src/SocketPluginImpl.c index aef32bf3e9..027fb79911 100644 --- a/plugins/SocketPlugin/src/SocketPluginImpl.c +++ b/plugins/SocketPlugin/src/SocketPluginImpl.c @@ -769,82 +769,6 @@ sqInt sqSocketError(SocketPtr s) } -/* return the local IP address bound to a socket */ - -sqInt sqSocketLocalAddress(SocketPtr s) -{ - struct sockaddr_in saddr; - socklen_t saddrSize= sizeof(saddr); - - if (!socketValid(s)) - return -1; - if (getsockname(SOCKET(s), (struct sockaddr *)&saddr, &saddrSize) - || (AF_INET != saddr.sin_family)) - return 0; - return ntohl(saddr.sin_addr.s_addr); -} - - -/* return the peer's IP address */ - -sqInt sqSocketRemoteAddress(SocketPtr s) -{ - struct sockaddr_in saddr; - socklen_t saddrSize= sizeof(saddr); - - if (!socketValid(s)) - return -1; - if (TCPSocketType == s->socketType) - { - /* --- TCP --- */ - if (getpeername(SOCKET(s), (struct sockaddr *)&saddr, &saddrSize) - || (AF_INET != saddr.sin_family)) - return 0; - return ntohl(saddr.sin_addr.s_addr); - } - /* --- UDP/RAW --- */ - return ntohl(SOCKETPEER(s).sin.sin_addr.s_addr); -} - - -/* return the local port number of a socket */ - -sqInt sqSocketLocalPort(SocketPtr s) -{ - struct sockaddr_in saddr; - socklen_t saddrSize= sizeof(saddr); - - if (!socketValid(s)) - return -1; - if (getsockname(SOCKET(s), (struct sockaddr *)&saddr, &saddrSize) - || (AF_INET != saddr.sin_family)) - return 0; - return ntohs(saddr.sin_port); -} - - -/* return the peer's port number */ - -sqInt sqSocketRemotePort(SocketPtr s) -{ - struct sockaddr_in saddr; - socklen_t saddrSize= sizeof(saddr); - - if (!socketValid(s)) - return -1; - if (TCPSocketType == s->socketType) - { - /* --- TCP --- */ - if (getpeername(SOCKET(s), (struct sockaddr *)&saddr, &saddrSize) - || (AF_INET != saddr.sin_family)) - return 0; - return ntohs(saddr.sin_port); - } - /* --- UDP/RAW --- */ - return ntohs(SOCKETPEER(s).sin.sin_port); -} - - /* answer whether the socket has data available for reading: if the socket is not connected, answer "false"; if the socket is open and data can be read, answer "true". @@ -1338,6 +1262,121 @@ sqInt socketReceiveUDPData(SocketPtr s, char *buf, sqInt bufSize, void * address return 0; } +static sqInt translateSocketType(sa_family_t sa_family){ + + switch(sa_family){ + case AF_UNSPEC: + return SOCKET_FAMILY_UNSPECIFIED; + + case AF_UNIX: + return SOCKET_FAMILY_LOCAL; + + case AF_INET: + return SOCKET_FAMILY_INET4; + + case AF_INET6: + return SOCKET_FAMILY_INET6; + + default: return -1; + } +} + +void socketLocalAddress(SocketPtr s, void* addr, size_t addrSize){ + struct sockaddr *sockaddr = (struct sockaddr*) addr; + socklen_t socklen = addrSize; + + memset(sockaddr, 0, addrSize); + + if(!socketValid(s)) { + success(false); + return; + } + + if(getsockname(SOCKET(s), sockaddr, &socklen)==-1){ + SOCKETERROR(s) = getLastSocketError(); + logTrace("socketLocalAddress(%d)= %da\n", SOCKET(s), 0); + + return; + } + +} + +void socketRemoteAddress(SocketPtr s, void* addr, size_t addrSize){ + struct sockaddr *sockaddr = (struct sockaddr*) addr; + socklen_t socklen = addrSize; + + memset(sockaddr, 0, addrSize); + + if(!socketValid(s)) { + success(false); + return; + } + + /* If it is UDP/RAW I will use the peersocket stored before */ + + if (s->socketType != TCPSocketType){ + memcpy(sockaddr, &SOCKETPEER(s), addrSize); + return; + } + + + if(getpeername(SOCKET(s), sockaddr, &socklen)==-1){ + SOCKETERROR(s) = getLastSocketError(); + logTrace("socketRemoteAddress(%d)= %da\n", SOCKET(s), 0); + + return; + } + +} + + +sqInt socketLocalAddressType(SocketPtr s){ + struct sockaddr sockaddr; + socklen_t socklen = sizeof(struct sockaddr); + + memset(&sockaddr, 0, sizeof(sockaddr)); + + if(!socketValid(s)) { + success(false); + return SOCKET_FAMILY_UNSPECIFIED; + } + + if(getsockname(SOCKET(s), &sockaddr, &socklen)==-1){ + SOCKETERROR(s) = getLastSocketError(); + logTrace("socketLocalAddressType(%d)= %da\n", SOCKET(s), 0); + + return SOCKET_FAMILY_UNSPECIFIED; + } + + return translateSocketType(sockaddr.sa_family); +} + +sqInt socketRemoteAddressType(SocketPtr s){ + struct sockaddr sockaddr; + socklen_t socklen = sizeof(struct sockaddr); + + memset(&sockaddr, 0, sizeof(sockaddr)); + + if(!socketValid(s)) { + success(false); + return SOCKET_FAMILY_UNSPECIFIED; + } + + /* If it is UDP/RAW I will use the peersocket stored before */ + + if (s->socketType != TCPSocketType){ + return translateSocketType(SOCKETPEER(s).sa.sa_family); + } + + if(getpeername(SOCKET(s), &sockaddr, &socklen)==-1){ + SOCKETERROR(s) = getLastSocketError(); + logTrace("socketRemoteAddressType(%d)= %da\n", SOCKET(s), 0); + + return SOCKET_FAMILY_UNSPECIFIED; + } + + return translateSocketType(sockaddr.sa_family); +} void* newIP4SockAddr(int address, int port) { struct sockaddr_in* r = (struct sockaddr_in*) malloc(sizeof(struct sockaddr_in)); @@ -1359,7 +1398,6 @@ void ip4UpdateAddress(sqInt addressOop, void* addr){ struct sockaddr_in* address = (struct sockaddr_in*)addr; if(address->sin_family != AF_INET){ - success(false); return; } From 8afe3815f4816ec6e865c6d4574f3f44378c66d8 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Fri, 10 Sep 2021 15:42:48 +0200 Subject: [PATCH 12/16] Changing resolution of remote and local addresses --- smalltalksrc/VMMaker/SocketPlugin.class.st | 158 +++++++++++++----- .../VMMaker/SocketPluginSimulator.class.st | 4 +- 2 files changed, 119 insertions(+), 43 deletions(-) diff --git a/smalltalksrc/VMMaker/SocketPlugin.class.st b/smalltalksrc/VMMaker/SocketPlugin.class.st index 452ddf9980..5709ba80e1 100644 --- a/smalltalksrc/VMMaker/SocketPlugin.class.st +++ b/smalltalksrc/VMMaker/SocketPlugin.class.st @@ -43,7 +43,7 @@ SocketPlugin >> addressStructFor: aSocketAddress [ | addressType | addressType := self getAddressType: aSocketAddress. - interpreterProxy failed ifTrue: [ ^ nil ]. + addressType = 0 ifTrue: [ ^ interpreterProxy primitiveFail. ]. addressType = self ip4AddressType ifTrue: [ @@ -62,7 +62,7 @@ SocketPlugin >> addressStructSizeFor: aSocketAddress [ | addressType | addressType := self getAddressType: aSocketAddress. - interpreterProxy failed ifTrue: [ ^ nil ]. + addressType = 0 ifTrue: [ ^ interpreterProxy primitiveFail. ]. addressType = self ip4AddressType ifTrue: [ ^ self ip4SockSize ]. @@ -456,6 +456,52 @@ SocketPlugin >> primitiveResolverStatus [ ^status asSmallIntegerObj ] +{ #category : #'primitives - status' } +SocketPlugin >> primitiveSocket: socket LocalAddress: socketAddressOop [ + + + + + + | s addr addrSize | + self primitive: 'primitiveSocketLocalAddress' parameters: #(Oop Oop). + + s := self socketValueOf: socket. + + addr := self addressStructFor: socketAddressOop. + addrSize := self addressStructSizeFor: socketAddressOop. + + interpreterProxy failed + ifFalse: [ + self socketLocalAddress: s _: addr _: addrSize. + self updateAddress: socketAddressOop from: addr. + self free: addr ]. + +] + +{ #category : #'primitives - status' } +SocketPlugin >> primitiveSocket: socket RemoteAddress: socketAddressOop [ + + + + + + | s addr addrSize | + self primitive: 'primitiveSocketRemoteAddress' parameters: #(Oop Oop). + + s := self socketValueOf: socket. + + addr := self addressStructFor: socketAddressOop. + addrSize := self addressStructSizeFor: socketAddressOop. + + interpreterProxy failed + ifFalse: [ + self socketRemoteAddress: s _: addr _: addrSize. + self updateAddress: socketAddressOop from: addr. + self free: addr ]. + +] + { #category : #'primitives - connection' } SocketPlugin >> primitiveSocket: socket bindTo: socketAddressOop [ @@ -803,7 +849,7 @@ SocketPlugin >> primitiveSocketCreateNetwork: netType type: socketType receiveBu { #category : #'primitives - creation' } SocketPlugin >> primitiveSocketCreateRaw: netType type: protoType receiveBufferSize: recvBufSize sendBufSize: sendBufSize semaIndex: semaIndex readSemaIndex: aReadSema writeSemaIndex: aWriteSema [ - | socketOop s okToCreate | + | socketOop s | self primitive: 'primitiveSocketCreateRAW' parameters: #(#SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger ). @@ -847,28 +893,20 @@ SocketPlugin >> primitiveSocketError: socket [ ^err asSmallIntegerObj ] -{ #category : #primitives } -SocketPlugin >> primitiveSocketLocalAddress: socket [ +{ #category : #'primitives - status' } +SocketPlugin >> primitiveSocketLocalAddressType: socket [ - | s addr | - self primitive: 'primitiveSocketLocalAddress' - parameters: #(Oop). - s := self socketValueOf: socket. - addr := self sqSocketLocalAddress: s. - ^self intToNetAddress: addr -] -{ #category : #primitives } -SocketPlugin >> primitiveSocketLocalPort: socket [ + | s | + self primitive: 'primitiveSocketLocalAddressType' parameters: #(#Oop). - | s port | - - self primitive: 'primitiveSocketLocalPort' - parameters: #(Oop). s := self socketValueOf: socket. - port := self sqSocketLocalPort: s. - ^port asSmallIntegerObj + + interpreterProxy failed ifFalse: [ + ^ (self socketLocalAddressType: s) asSmallIntegerObj ]. + + ^ 0 asSmallIntegerObj ] { #category : #'primitives - sending/receiving' } @@ -883,28 +921,20 @@ SocketPlugin >> primitiveSocketReceiveDataAvailable: socket [ ^dataIsAvailable asBooleanObj ] -{ #category : #primitives } -SocketPlugin >> primitiveSocketRemoteAddress: socket [ +{ #category : #'primitives - status' } +SocketPlugin >> primitiveSocketRemoteAddressType: socket [ - | s addr | - self primitive: 'primitiveSocketRemoteAddress' - parameters: #(Oop). - s := self socketValueOf: socket. - addr := self sqSocketRemoteAddress: s. - ^self intToNetAddress: addr -] -{ #category : #primitives } -SocketPlugin >> primitiveSocketRemotePort: socket [ + | s | + self primitive: 'primitiveSocketRemoteAddressType' parameters: #(#Oop). - | s port | - - self primitive: 'primitiveSocketRemotePort' - parameters: #(Oop). s := self socketValueOf: socket. - port := self sqSocketRemotePort: s. - ^port asSmallIntegerObj + + interpreterProxy failed ifFalse: [ + ^ (self socketRemoteAddressType: s) asSmallIntegerObj ]. + + ^ 0 asSmallIntegerObj ] { #category : #'primitives - status' } @@ -953,6 +983,27 @@ SocketPlugin >> shutdownModule [ ^self cCode: 'socketShutdown()' inSmalltalk:[true] ] +{ #category : #'for - simulation' } +SocketPlugin >> socket: s ConnectToAddress: addr Size: addrSize [ + + + self subclassResponsibility +] + +{ #category : #'for - simulation' } +SocketPlugin >> socketBindTo: s _: addr _: addrSize [ + + + self subclassResponsibility +] + +{ #category : #'for - simulation' } +SocketPlugin >> socketListenOn: s _: addr _: addrSize _: backlogSize [ + + + self subclassResponsibility +] + { #category : #primitives } SocketPlugin >> socketRecordSize [ "Return the size of a Smalltalk socket record in bytes." @@ -971,6 +1022,35 @@ SocketPlugin >> socketValueOf: socketOop [ ifFalse: [interpreterProxy primitiveFailFor: PrimErrBadArgument. nil] ] +{ #category : #'for - simulation' } +SocketPlugin >> sqNetworkInit: resolverSemaIndex [ + + + + self subclassResponsibility +] + +{ #category : #'for - simulation' } +SocketPlugin >> sqSocketAbortConnection: s [ + + + self subclassResponsibility +] + +{ #category : #'for - simulation' } +SocketPlugin >> sqSocketCloseConnection: s [ + + + self subclassResponsibility +] + +{ #category : #'for - simulation' } +SocketPlugin >> sqSocketDestroy: socketPtr [ + + + self subclassResponsibility +] + { #category : #'accessing - ip4' } SocketPlugin >> updateAddress: socketAddressOop from: addr [ @@ -980,10 +1060,8 @@ SocketPlugin >> updateAddress: socketAddressOop from: addr [ | addressType | addressType := self getAddressType: socketAddressOop. - interpreterProxy failed ifTrue: [ ^ nil ]. + addressType = 0 ifTrue: [ ^ self ]. addressType = self ip4AddressType ifTrue: [ ^ self ip4UpdateAddress: socketAddressOop _: addr ]. - - ^ interpreterProxy primitiveFail. ] diff --git a/smalltalksrc/VMMaker/SocketPluginSimulator.class.st b/smalltalksrc/VMMaker/SocketPluginSimulator.class.st index 06f4bfa2b4..26fbeb8c8d 100644 --- a/smalltalksrc/VMMaker/SocketPluginSimulator.class.st +++ b/smalltalksrc/VMMaker/SocketPluginSimulator.class.st @@ -148,9 +148,7 @@ SocketPluginSimulator >> socketInit [ hostSocketToSimSocketMap := Dictionary new. simSocketToHostSocketMap := Dictionary new. fakeAddressCounter := 16r50C4E70. "Socket, if you squint at it right..." - "Set all the security functions to zero so simulation does't need to work fully." - sDSAfn := sHSAfn := sCCTPfn := sCCLOPfn := sCCSOTfn := 0. - "for now..." + ipv6support := false. resolverStatus := ResolverUninitialized. ^true From 94a326d978b7e5766c33b125a0bbb32b93d9f7b7 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Tue, 14 Sep 2021 16:08:21 +0200 Subject: [PATCH 13/16] Simplifying multi domain addresses --- plugins/SocketPlugin/include/SocketPlugin.h | 27 +- .../SocketPlugin/include/SocketPluginImpl.h | 3 + plugins/SocketPlugin/src/SocketPluginImpl.c | 498 +++++++++++------- 3 files changed, 316 insertions(+), 212 deletions(-) diff --git a/plugins/SocketPlugin/include/SocketPlugin.h b/plugins/SocketPlugin/include/SocketPlugin.h index e866bacca8..6cbb6e3792 100644 --- a/plugins/SocketPlugin/include/SocketPlugin.h +++ b/plugins/SocketPlugin/include/SocketPlugin.h @@ -58,25 +58,14 @@ void sqResolverGetNameInfoServiceResultSize(char *name, sqInt nameSize); sqInt sqResolverHostNameSize(void); void sqResolverHostNameResultSize(char *name, sqInt nameSize); -void socketConnectToAddressSize(SocketPtr s, void* addr, size_t addrSize); -void socketListenOn(SocketPtr s, void* address, size_t addressSize, int backlogSize); -void socketBindTo(SocketPtr s, void *address, size_t addrSize); -sqInt socketSendUDPDataToAddress(SocketPtr s, void* address, size_t addrSize, char* buffer, size_t bufferLength); -sqInt socketReceiveUDPData(SocketPtr s, char *buf, sqInt bufSize, void * address, size_t addrSize); - -void socketLocalAddress(SocketPtr s, void* addr, size_t addrSize); -sqInt socketLocalAddressType(SocketPtr s); - -void socketRemoteAddress(SocketPtr s, void* addr, size_t addrSize); -sqInt socketRemoteAddressType(SocketPtr s); - -void* newIP4SockAddr(int address, int port); -size_t ip4SockSize(); - -void setIp4Addressvalue(sqInt addressOop, sqInt address); -void setIp4Portvalue(sqInt addressOop, sqInt port); -void ip4UpdateAddress(sqInt addressOop, void* addr); - +void socketConnectToAddress(SocketPtr s, sqInt socketAddressOop); +void socketListenOn(SocketPtr s, sqInt socketAddressOop, int backlogSize); +void socketBindTo(SocketPtr s, sqInt socketAddressOop); +sqInt socketSendUDPDataToAddress(SocketPtr s, sqInt socketAddressOop, char* buffer, size_t bufferLength); +sqInt socketReceiveUDPData(SocketPtr s, char *buf, sqInt bufSize, sqInt socketAddressOop); + +void socketLocalAddress(SocketPtr s, sqInt socketAddressOop); +void socketRemoteAddress(SocketPtr s, sqInt socketAddressOop); /* family */ diff --git a/plugins/SocketPlugin/include/SocketPluginImpl.h b/plugins/SocketPlugin/include/SocketPluginImpl.h index 7f186faa45..78c0d2f950 100644 --- a/plugins/SocketPlugin/include/SocketPluginImpl.h +++ b/plugins/SocketPlugin/include/SocketPluginImpl.h @@ -108,3 +108,6 @@ int getNetSessionID(); void nameResolverInit(sqInt resolverSemaIndex); void nameResolverFini(); + +void updateAddressObject(sqInt socketAddressOop, struct sockaddr_storage * sockaddr); +void updateSockAddressStruct(sqInt socketAddressOop, struct sockaddr_storage * sockaddr); diff --git a/plugins/SocketPlugin/src/SocketPluginImpl.c b/plugins/SocketPlugin/src/SocketPluginImpl.c index 027fb79911..6201499e19 100644 --- a/plugins/SocketPlugin/src/SocketPluginImpl.c +++ b/plugins/SocketPlugin/src/SocketPluginImpl.c @@ -44,14 +44,6 @@ static int one = 1; #endif -union sockaddr_any -{ - struct sockaddr sa; - struct sockaddr_un saun; - struct sockaddr_in sin; - struct sockaddr_in6 sin6; -}; - typedef struct privateSocketStruct { int s; /* Unix socket */ @@ -60,10 +52,7 @@ typedef struct privateSocketStruct int writeSema; /* write io notification semaphore */ int sockState; /* connection + data state */ int sockError; /* errno after socket error */ - union sockaddr_any peer; /* default send/recv address for UDP */ - socklen_t peerSize; /* dynamic sizeof(peer) */ - union sockaddr_any sender; /* sender address for last UDP receive */ - socklen_t senderSize; /* dynamic sizeof(sender) */ + struct sockaddr_storage peer; /* default send/recv address for UDP */ int multiListen; /* whether to listen for multiple connections */ int acceptedSock; /* a connection that has been accepted */ int socketType; @@ -87,8 +76,6 @@ typedef struct privateSocketStruct } -/*** Accessors for private socket members from a Squeak socket pointer ***/ - #define _PSP(S) (((S)->privateSocketPtr)) #define PSP(S) ((privateSocketStruct *)((S)->privateSocketPtr)) @@ -96,7 +83,6 @@ typedef struct privateSocketStruct #define SOCKETSTATE(S) (PSP(S)->sockState) #define SOCKETERROR(S) (PSP(S)->sockError) #define SOCKETPEER(S) (PSP(S)->peer) -#define SOCKETPEERSIZE(S) (PSP(S)->peerSize) /*** Variables ***/ @@ -441,8 +427,6 @@ void sqNetworkShutdown(void) aioFini(); } -/*** Squeak Generic Socket Functions ***/ - void sqSocketCreateNetTypeSocketTypeRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(SocketPtr s, sqInt domain, sqInt socketType, sqInt recvBufSize, sqInt sendBufSize, sqInt semaIndex, sqInt readSemaIndex, sqInt writeSemaIndex) { @@ -516,10 +500,13 @@ void sqSocketCreateNetTypeSocketTypeRecvBytesSendBytesSemaIDReadSemaIDWriteSemaI pss->sockError= 0; /* initial UDP peer := wildcard */ memset(&pss->peer, 0, sizeof(pss->peer)); - pss->peer.sin.sin_family= AF_INET; - pss->peer.sin.sin_port= 0; - pss->peer.sin.sin_addr.s_addr= INADDR_ANY; - /* Squeak socket */ + + struct sockaddr_in * sin = (struct sockaddr_in *)&pss->peer; + + sin->sin_family= AF_INET; + sin->sin_port= 0; + sin->sin_addr.s_addr= INADDR_ANY; + s->sessionID= getNetSessionID(); s->socketType= socketType; s->privateSocketPtr= pss; @@ -563,11 +550,12 @@ void sqSocketCreateRawProtoTypeRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(Soc aioEnable(pss->s, pss, 0); pss->sockError= 0; /* initial UDP peer := wildcard */ - memset(&pss->peer, 0, sizeof(pss->peer)); - pss->peer.sin.sin_family= AF_INET; - pss->peer.sin.sin_port= 0; - pss->peer.sin.sin_addr.s_addr= INADDR_ANY; - /* Squeak socket */ + struct sockaddr_in * sin = (struct sockaddr_in *)&pss->peer; + + sin->sin_family= AF_INET; + sin->sin_port= 0; + sin->sin_addr.s_addr= INADDR_ANY; + s->sessionID= getNetSessionID(); s->socketType= RAWSocketType; s->privateSocketPtr= pss; @@ -595,35 +583,6 @@ sqInt sqSocketConnectionStatus(SocketPtr s) return SOCKETSTATE(s); } -void socketListenOn(SocketPtr s, void* address, size_t addressSize, int backlogSize) { - - struct sockaddr* addr = (struct sockaddr*) address; - - if (!socketValid(s)) - return; - - /* only TCP sockets have a backlog */ - if ((backlogSize > 1) && (s->socketType != TCPSocketType)) { - success(false); - return; - } - - PSP(s)->multiListen = (backlogSize > 1); - logTrace("listenOnPortBacklogSize(%d, %ld)\n", SOCKET(s), backlogSize); - - bind(SOCKET(s), addr, addressSize); - - if (TCPSocketType == s->socketType) { - /* --- TCP --- */ - listen(SOCKET(s), backlogSize); - SOCKETSTATE(s) = WaitingForConnection; - aioEnable(SOCKET(s), PSP(s), 0); - aioHandle(SOCKET(s), acceptHandler, AIO_RX); /* R => accept() */ - } else { - /* --- UDP/RAW --- */ - } -} - void sqSocketAcceptFromRecvBytesSendBytesSemaIDReadSemaIDWriteSemaID(SocketPtr s, SocketPtr serverSocket, sqInt recvBufSize, sqInt sendBufSize, sqInt semaIndex, sqInt readSemaIndex, sqInt writeSemaIndex) { /* The image has already called waitForConnection, so there is no @@ -824,56 +783,50 @@ sqInt sqSocketSendDone(SocketPtr s) answer the number actually read. For UDP, fill in the peer's address with the approriate value. */ -sqInt sqSocketReceiveDataBufCount(SocketPtr s, char *buf, sqInt bufSize) -{ - int nread= 0; - int lastError; - - if (!socketValid(s)) - return -1; +sqInt sqSocketReceiveDataBufCount(SocketPtr s, char *buf, sqInt bufSize) { + int nread = 0; + int lastError; - SOCKETPEERSIZE(s)= 0; + if (!socketValid(s)) + return -1; - if (TCPSocketType != s->socketType) - { - /* --- UDP/RAW --- */ - socklen_t addrSize= sizeof(SOCKETPEER(s)); - if ((nread= recvfrom(SOCKET(s), buf, bufSize, 0, (struct sockaddr *)&SOCKETPEER(s), &addrSize)) <= 0) { + if (TCPSocketType != s->socketType) { + /* --- UDP/RAW --- */ + socklen_t addrSize = sizeof(SOCKETPEER(s)); + if ((nread = recvfrom(SOCKET(s), buf, bufSize, 0, + (struct sockaddr *) &SOCKETPEER(s), &addrSize)) <= 0) { - lastError = getLastSocketError(); + lastError = getLastSocketError(); - if ((nread == -1) && (lastError == ERROR_WOULD_BLOCK)) { - logTrace("UDP receiveData(%d) < 1 [blocked]\n", SOCKET(s)); - return 0; - } - SOCKETERROR(s) = lastError; - logTrace("UDP receiveData(%d) < 1 [a:%d]\n", SOCKET(s), lastError); - return 0; - } - SOCKETPEERSIZE(s)= addrSize; - } - else - { - /* --- TCP --- */ - if ((nread= recv(SOCKET(s), buf, bufSize, 0)) <= 0) { - lastError = getLastSocketError(); + if ((nread == -1) && (lastError == ERROR_WOULD_BLOCK)) { + logTrace("UDP receiveData(%d) < 1 [blocked]\n", SOCKET(s)); + return 0; + } + SOCKETERROR(s) = lastError; + logTrace("UDP receiveData(%d) < 1 [a:%d]\n", SOCKET(s), lastError); + return 0; + } + } else { + /* --- TCP --- */ + if ((nread = recv(SOCKET(s), buf, bufSize, 0)) <= 0) { + lastError = getLastSocketError(); - if ((nread == -1) && (lastError == ERROR_WOULD_BLOCK)) - { - logTrace("TCP receiveData(%d) < 1 [blocked]\n", SOCKET(s)); - return 0; + if ((nread == -1) && (lastError == ERROR_WOULD_BLOCK)) { + logTrace("TCP receiveData(%d) < 1 [blocked]\n", SOCKET(s)); + return 0; } - /* connection reset */ - SOCKETSTATE(s)= OtherEndClosed; - SOCKETERROR(s)= lastError; - logTrace("TCP receiveData(%d) < 1 [b:%d] return: %d", SOCKET(s), lastError, nread); - notify(PSP(s), CONN_NOTIFY); - return 0; - } - } - /* read completed synchronously */ - logTrace( "receiveData(%d) done = %d\n", SOCKET(s), nread); - return nread; + /* connection reset */ + SOCKETSTATE(s) = OtherEndClosed; + SOCKETERROR(s) = lastError; + logTrace("TCP receiveData(%d) < 1 [b:%d] return: %d", SOCKET(s), + lastError, nread); + notify(PSP(s), CONN_NOTIFY); + return 0; + } + } + /* read completed synchronously */ + logTrace("receiveData(%d) done = %d\n", SOCKET(s), nread); + return nread; } @@ -1125,9 +1078,50 @@ void sqSocketSetReusable(SocketPtr s) } } -void socketBindTo(SocketPtr s, void *address, size_t addrSize) { +void socketListenOn(SocketPtr s, sqInt socketAddressOop, int backlogSize) { + + struct sockaddr_storage saddr; + socklen_t saddrSize = sizeof(struct sockaddr_in); + int lastError; + + if (!socketValid(s)) + return; + + /* only TCP sockets have a backlog */ + if ((backlogSize > 1) && (s->socketType != TCPSocketType)) { + success(false); + return; + } + + updateSockAddressStruct(socketAddressOop, &saddr); + if(interpreterProxy->failed()){ + return; + } + + PSP(s)->multiListen = (backlogSize > 1); + logTrace("listenOnPortBacklogSize(%d, %ld)\n", SOCKET(s), backlogSize); + + lastError = bind(SOCKET(s), (struct sockaddr *) &saddr, saddrSize); + + if(lastError == -1){ + logWarnFromErrno("Bind"); + } + + if (TCPSocketType == s->socketType) { + /* --- TCP --- */ + listen(SOCKET(s), backlogSize); + SOCKETSTATE(s) = WaitingForConnection; + aioEnable(SOCKET(s), PSP(s), 0); + aioHandle(SOCKET(s), acceptHandler, AIO_RX); /* R => accept() */ + } else { + /* --- UDP/RAW --- */ + } +} + +void socketBindTo(SocketPtr s, sqInt socketAddressOop) { - struct sockaddr* addr = (struct sockaddr*) address; + struct sockaddr_storage saddr; + socklen_t saddrSize = sizeof(struct sockaddr_in); privateSocketStruct *pss = PSP(s); @@ -1136,7 +1130,12 @@ void socketBindTo(SocketPtr s, void *address, size_t addrSize) { return; } - if (bind(SOCKET(s), addr, addrSize) == 0) + updateSockAddressStruct(socketAddressOop, &saddr); + if(interpreterProxy->failed()){ + return; + } + + if (bind(SOCKET(s), (struct sockaddr *)&saddr, saddrSize) == 0) return; pss->sockError = getLastSocketError(); @@ -1144,13 +1143,15 @@ void socketBindTo(SocketPtr s, void *address, size_t addrSize) { } -void socketConnectToAddressSize(SocketPtr s, void* address, size_t addrSize){ +void socketConnectToAddress(SocketPtr s, sqInt socketAddressOop){ /* TCP => open a connection. * UDP => set remote address. */ - struct sockaddr* addr = (struct sockaddr*) address; + struct sockaddr_storage saddr; + socklen_t saddrSize = sizeof(struct sockaddr_in); + if (!socketValid(s)) { success(false); @@ -1159,6 +1160,11 @@ void socketConnectToAddressSize(SocketPtr s, void* address, size_t addrSize){ logTrace("connectToAddressSize(%d)\n", SOCKET(s)); + updateSockAddressStruct(socketAddressOop, &saddr); + if(interpreterProxy->failed()){ + return; + } + if (TCPSocketType != s->socketType) { /* --- UDP/RAW --- */ @@ -1167,11 +1173,9 @@ void socketConnectToAddressSize(SocketPtr s, void* address, size_t addrSize){ int result; - memcpy((void *) &SOCKETPEER(s), addr, addrSize); + memcpy((void *) &SOCKETPEER(s), (struct sockaddr *)&saddr, saddrSize); - SOCKETPEERSIZE(s) = addrSize; - - result = connect(SOCKET(s), addr, addrSize); + result = connect(SOCKET(s), (struct sockaddr *)&saddr, saddrSize); if (result == 0) SOCKETSTATE(s) = Connected; @@ -1180,7 +1184,7 @@ void socketConnectToAddressSize(SocketPtr s, void* address, size_t addrSize){ { int result; aioEnable(SOCKET(s), PSP(s), 0); - result = connect(SOCKET(s), addr, addrSize); + result = connect(SOCKET(s), (struct sockaddr *)&saddr, saddrSize); logTrace("connect() => %d\n", result); @@ -1209,15 +1213,21 @@ void socketConnectToAddressSize(SocketPtr s, void* address, size_t addrSize){ } } -sqInt socketSendUDPDataToAddress(SocketPtr s, void* address, size_t addrSize, char* buffer, size_t bufferLength) { +sqInt socketSendUDPDataToAddress(SocketPtr s, sqInt socketAddressOop, char* buffer, size_t bufferLength) { - struct sockaddr* addr = (struct sockaddr*)address; + struct sockaddr_storage saddr; + socklen_t saddrSize = sizeof(struct sockaddr_in); if (socketValid(s) && (TCPSocketType != s->socketType)) { + updateSockAddressStruct(socketAddressOop, &saddr); + if(interpreterProxy->failed()){ + return 0; + } + logTrace("sendTo(%d)\n", SOCKET(s)); - int nsent = sendto(SOCKET(s), buffer, bufferLength, 0, addr, addrSize); + int nsent = sendto(SOCKET(s), buffer, bufferLength, 0, (struct sockaddr *)&saddr, saddrSize); if (nsent >= 0) return nsent; @@ -1235,18 +1245,19 @@ sqInt socketSendUDPDataToAddress(SocketPtr s, void* address, size_t addrSize, ch return 0; } -sqInt socketReceiveUDPData(SocketPtr s, char *buf, sqInt bufSize, void * address, size_t addrSize) { +sqInt socketReceiveUDPData(SocketPtr s, char *buf, sqInt bufSize, sqInt socketAddressOop) { int lastError; - struct sockaddr* saddr = (struct sockaddr*) address; - socklen_t saddrSize = addrSize; + struct sockaddr_storage saddr; + socklen_t saddrSize = sizeof(struct sockaddr_in); if (socketValid(s) && (TCPSocketType != s->socketType)) /* --- UDP/RAW --- */ { logTrace("recvFrom(%d)\n", SOCKET(s)); - int nread = recvfrom(SOCKET(s), buf, bufSize, 0, saddr, &saddrSize); + int nread = recvfrom(SOCKET(s), buf, bufSize, 0, (struct sockaddr *)&saddr, &saddrSize); if (nread >= 0) { + updateAddressObject(socketAddressOop, &saddr); return nread; } @@ -1262,146 +1273,247 @@ sqInt socketReceiveUDPData(SocketPtr s, char *buf, sqInt bufSize, void * address return 0; } -static sqInt translateSocketType(sa_family_t sa_family){ - - switch(sa_family){ - case AF_UNSPEC: - return SOCKET_FAMILY_UNSPECIFIED; - - case AF_UNIX: - return SOCKET_FAMILY_LOCAL; - - case AF_INET: - return SOCKET_FAMILY_INET4; - - case AF_INET6: - return SOCKET_FAMILY_INET6; - - default: return -1; - } -} - -void socketLocalAddress(SocketPtr s, void* addr, size_t addrSize){ - struct sockaddr *sockaddr = (struct sockaddr*) addr; - socklen_t socklen = addrSize; +void socketLocalAddress(SocketPtr s, sqInt socketAddressOop){ + struct sockaddr_storage sockaddr; + socklen_t socklen = sizeof(struct sockaddr_in); - memset(sockaddr, 0, addrSize); if(!socketValid(s)) { success(false); return; } - if(getsockname(SOCKET(s), sockaddr, &socklen)==-1){ + memset((void*)&sockaddr, 0, socklen); + + if(getsockname(SOCKET(s), (struct sockaddr*)&sockaddr, &socklen)==-1){ SOCKETERROR(s) = getLastSocketError(); - logTrace("socketLocalAddress(%d)= %da\n", SOCKET(s), 0); + logTrace("socketRemoteAddress(%d)= %da\n", SOCKET(s), 0); + success(false); return; } + updateAddressObject(socketAddressOop, &sockaddr); } -void socketRemoteAddress(SocketPtr s, void* addr, size_t addrSize){ - struct sockaddr *sockaddr = (struct sockaddr*) addr; - socklen_t socklen = addrSize; +void socketRemoteAddress(SocketPtr s, sqInt socketAddressOop){ + struct sockaddr_storage sockaddr; + socklen_t socklen = sizeof(struct sockaddr_in); - memset(sockaddr, 0, addrSize); if(!socketValid(s)) { success(false); return; } + memset((void*)&sockaddr, 0, socklen); + /* If it is UDP/RAW I will use the peersocket stored before */ if (s->socketType != TCPSocketType){ - memcpy(sockaddr, &SOCKETPEER(s), addrSize); + updateAddressObject(socketAddressOop, &SOCKETPEER(s)); return; } - if(getpeername(SOCKET(s), sockaddr, &socklen)==-1){ + if(getpeername(SOCKET(s), (struct sockaddr*)&sockaddr, &socklen)==-1){ SOCKETERROR(s) = getLastSocketError(); logTrace("socketRemoteAddress(%d)= %da\n", SOCKET(s), 0); + if(SOCKETERROR(s) == ENOTCONN){ + // If the socket is not connected we return all 0.0.0.0 + return; + } + + success(false); return; } + updateAddressObject(socketAddressOop, &sockaddr); } +/* + * Handling different address kinds + * + * Addresses are represented by an object with: + * + * - A SmallInteger to identify the type of address (check translateSocketType to know the valid values) + * - A ByteArray with the address information if it is a IPv4 or IPv6, and a byteString if it is a unix socket + * - A SmallInteger with the port (if non unix address). + */ + +static sqInt translateToSocketDomain(sqInt type) { + switch (type) { + case SOCKET_FAMILY_UNSPECIFIED: + return AF_UNSPEC; + case SOCKET_FAMILY_LOCAL: + return AF_UNIX; + case SOCKET_FAMILY_INET4: + return AF_INET; + case SOCKET_FAMILY_INET6: + return AF_INET6; + default: + logDebug("Invalid SocketFamily: %d", type); + success(false); + return AF_UNSPEC; + } +} -sqInt socketLocalAddressType(SocketPtr s){ - struct sockaddr sockaddr; - socklen_t socklen = sizeof(struct sockaddr); +static sqInt translateSocketType(sa_family_t sa_family){ - memset(&sockaddr, 0, sizeof(sockaddr)); + switch(sa_family){ + case AF_UNSPEC: + return SOCKET_FAMILY_UNSPECIFIED; - if(!socketValid(s)) { - success(false); - return SOCKET_FAMILY_UNSPECIFIED; - } + case AF_UNIX: + return SOCKET_FAMILY_LOCAL; - if(getsockname(SOCKET(s), &sockaddr, &socklen)==-1){ - SOCKETERROR(s) = getLastSocketError(); - logTrace("socketLocalAddressType(%d)= %da\n", SOCKET(s), 0); + case AF_INET: + return SOCKET_FAMILY_INET4; - return SOCKET_FAMILY_UNSPECIFIED; - } + case AF_INET6: + return SOCKET_FAMILY_INET6; - return translateSocketType(sockaddr.sa_family); + default: return -1; + } } -sqInt socketRemoteAddressType(SocketPtr s){ - struct sockaddr sockaddr; - socklen_t socklen = sizeof(struct sockaddr); - memset(&sockaddr, 0, sizeof(sockaddr)); +void updateAddressObject(sqInt socketAddressOop, struct sockaddr_storage * sockaddr){ - if(!socketValid(s)) { + sqInt addressInformation; + sqInt portNumber; + struct sockaddr_un* unixSocketAddress = (struct sockaddr_un*)sockaddr; + struct sockaddr_in* ipv4SocketAddress = (struct sockaddr_in*)sockaddr; + struct sockaddr_in6* ipv6SocketAddress = (struct sockaddr_in6*)sockaddr; + + if(interpreterProxy->slotSizeOf(socketAddressOop) < 3){ success(false); - return SOCKET_FAMILY_UNSPECIFIED; + return; } - /* If it is UDP/RAW I will use the peersocket stored before */ + sqInt addressLength = strlen(unixSocketAddress->sun_path); - if (s->socketType != TCPSocketType){ - return translateSocketType(SOCKETPEER(s).sa.sa_family); - } + switch(sockaddr->ss_family){ + case AF_UNIX: - if(getpeername(SOCKET(s), &sockaddr, &socklen)==-1){ - SOCKETERROR(s) = getLastSocketError(); - logTrace("socketRemoteAddressType(%d)= %da\n", SOCKET(s), 0); + addressInformation = interpreterProxy->instantiateClassindexableSize(interpreterProxy->classString(), addressLength); + + if(interpreterProxy->failed()){ + logDebug("Cannot allocate string of size %d", addressLength); + return; + } + + memcpy(interpreterProxy->firstIndexableField(addressInformation), unixSocketAddress->sun_path, addressLength); + portNumber = interpreterProxy->integerObjectOf(0); + break; + + case AF_INET: + + addressInformation = interpreterProxy->instantiateClassindexableSize(interpreterProxy->classByteArray(), sizeof(ipv4SocketAddress->sin_addr.s_addr)); + + if(interpreterProxy->failed()){ + logDebug("Cannot allocate ByteArray of size %ld", sizeof(ipv4SocketAddress->sin_addr.s_addr)); + return; + } + + memcpy(interpreterProxy->firstIndexableField(addressInformation), &(ipv4SocketAddress->sin_addr.s_addr), sizeof(ipv4SocketAddress->sin_addr.s_addr)); + portNumber = interpreterProxy->integerObjectOf(ntohs(ipv4SocketAddress->sin_port)); + break; + + case AF_INET6: + + addressInformation = interpreterProxy->instantiateClassindexableSize(interpreterProxy->classByteArray(), sizeof(ipv6SocketAddress->sin6_addr)); + + if(interpreterProxy->failed()){ + logDebug("Cannot allocate ByteArray of size %ld", sizeof(ipv6SocketAddress->sin6_addr)); + return; + } - return SOCKET_FAMILY_UNSPECIFIED; + memcpy(interpreterProxy->firstIndexableField(addressInformation), &(ipv6SocketAddress->sin6_addr), sizeof(ipv4SocketAddress->sin_addr.s_addr)); + portNumber = interpreterProxy->integerObjectOf(ntohs(ipv6SocketAddress->sin6_port)); + break; + + default: + addressInformation = interpreterProxy->nilObject(); + portNumber = interpreterProxy->integerObjectOf(0); } - return translateSocketType(sockaddr.sa_family); + interpreterProxy->storeIntegerofObjectwithValue(0, socketAddressOop, translateSocketType(sockaddr->ss_family)); + interpreterProxy->storePointerofObjectwithValue(1, socketAddressOop, addressInformation); + interpreterProxy->storePointerofObjectwithValue(2, socketAddressOop, portNumber); } -void* newIP4SockAddr(int address, int port) { - struct sockaddr_in* r = (struct sockaddr_in*) malloc(sizeof(struct sockaddr_in)); +void updateSockAddressStruct(sqInt socketAddressOop, struct sockaddr_storage * sockaddr){ - memset(r, 0, sizeof(struct sockaddr_in)); + struct sockaddr_un* unixSocketAddress = (struct sockaddr_un*)sockaddr; + struct sockaddr_in* ipv4SocketAddress = (struct sockaddr_in*)sockaddr; + struct sockaddr_in6* ipv6SocketAddress = (struct sockaddr_in6*)sockaddr; - r->sin_family = AF_INET; - r->sin_port = htons((short)port); - r->sin_addr.s_addr = htonl(address); + char buffer[256]; - return r; -} + memset((void*)sockaddr, 0, sizeof(struct sockaddr_storage)); -size_t ip4SockSize(){ - return sizeof(struct sockaddr_in); -} + if(interpreterProxy->slotSizeOf(socketAddressOop) < 3){ + success(false); + return; + } -void ip4UpdateAddress(sqInt addressOop, void* addr){ - struct sockaddr_in* address = (struct sockaddr_in*)addr; + sqInt domain = translateToSocketDomain(interpreterProxy->fetchIntegerofObject(0, socketAddressOop)); + sqInt addressInformation = interpreterProxy->fetchPointerofObject(1, socketAddressOop); + sqInt portNumber = interpreterProxy->fetchIntegerofObject(2, socketAddressOop); - if(address->sin_family != AF_INET){ + if(interpreterProxy->failed()){ return; } - setIp4Addressvalue(addressOop, ntohl(address->sin_addr.s_addr)); - setIp4Portvalue(addressOop, ntohs(address->sin_port)); -} + if(!interpreterProxy->isBytes(addressInformation)){ + logDebug("Address Information in the SocketAddress is not indexable"); + success(false); + return; + } + + sqInt addressInformationSize = interpreterProxy->byteSizeOf(addressInformation); + + switch(domain){ + case AF_UNIX: + unixSocketAddress->sun_family = AF_UNIX; + memcpy(unixSocketAddress->sun_path, interpreterProxy->firstIndexableField(addressInformation), addressInformationSize); + unixSocketAddress->sun_path[addressInformationSize] = '\0'; + break; + case AF_INET: + + if(addressInformationSize != sizeof(ipv4SocketAddress->sin_addr.s_addr)){ + logDebug("Invalid information in the socketAddress, expecting %ld bytes for IPv4", sizeof(ipv4SocketAddress->sin_addr.s_addr)); + success(false); + return; + } + + ipv4SocketAddress->sin_family = AF_INET; + memcpy(&(ipv4SocketAddress->sin_addr.s_addr), interpreterProxy->firstIndexableField(addressInformation), sizeof(ipv4SocketAddress->sin_addr.s_addr)); + ipv4SocketAddress->sin_port = htons((short)portNumber); + + inet_ntop(AF_INET, &(ipv4SocketAddress->sin_addr), buffer, 256); + logTrace("Ip4 Address: %s", buffer); + break; + + case AF_INET6: + + if(addressInformationSize != sizeof(ipv6SocketAddress->sin6_addr)){ + logDebug("Invalid information in the socketAddress, expecting %ld bytes for IPv6", sizeof(ipv6SocketAddress->sin6_addr)); + success(false); + return; + } + + ipv6SocketAddress->sin6_family = AF_INET6; + memcpy(&(ipv6SocketAddress->sin6_addr), interpreterProxy->firstIndexableField(addressInformation), sizeof(ipv6SocketAddress->sin6_addr)); + ipv6SocketAddress->sin6_port = htons((short)portNumber); + break; + + default: + logError("Invalid domain type: %d", domain); + success(false); + return; + } +} From 23dfbe8d5f4d8fb1f090da459806b6d739a0bead Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Tue, 14 Sep 2021 16:10:38 +0200 Subject: [PATCH 14/16] Simplifying socket implementation --- smalltalksrc/VMMaker/SocketPlugin.class.st | 278 ++------------------- 1 file changed, 17 insertions(+), 261 deletions(-) diff --git a/smalltalksrc/VMMaker/SocketPlugin.class.st b/smalltalksrc/VMMaker/SocketPlugin.class.st index 5709ba80e1..5750ad8edc 100644 --- a/smalltalksrc/VMMaker/SocketPlugin.class.st +++ b/smalltalksrc/VMMaker/SocketPlugin.class.st @@ -35,91 +35,6 @@ SocketPlugin class >> shouldGenerateDeadCode [ ^ false ] -{ #category : #'accessing - ip4' } -SocketPlugin >> addressStructFor: aSocketAddress [ - - - - | addressType | - - addressType := self getAddressType: aSocketAddress. - addressType = 0 ifTrue: [ ^ interpreterProxy primitiveFail. ]. - - addressType = self ip4AddressType - ifTrue: [ - (self isValidIp4Address: aSocketAddress) - ifFalse: [ ^ nil ]. - ^ self newIP4SockAddr: (self getIp4Address: aSocketAddress) _: (self getIp4Port: aSocketAddress) ]. - - ^ interpreterProxy primitiveFail. -] - -{ #category : #'accessing - ip4' } -SocketPlugin >> addressStructSizeFor: aSocketAddress [ - - - - | addressType | - - addressType := self getAddressType: aSocketAddress. - addressType = 0 ifTrue: [ ^ interpreterProxy primitiveFail. ]. - - addressType = self ip4AddressType - ifTrue: [ ^ self ip4SockSize ]. - - ^ interpreterProxy primitiveFail. -] - -{ #category : #'accessing - ip4' } -SocketPlugin >> getAddressType: anAddressOop [ - - - - | type | - - (interpreterProxy isPointers: anAddressOop) - ifFalse: [ interpreterProxy primitiveFail. ^ nil ]. - - (interpreterProxy slotSizeOf: anAddressOop) >= 1 - ifFalse: [ interpreterProxy primitiveFail. ^ nil ]. - - type := interpreterProxy fetchInteger: 0 ofObject: anAddressOop. - interpreterProxy failed ifTrue: [ ^ nil ]. - - ^ type -] - -{ #category : #'accessing - ip4' } -SocketPlugin >> getIp4Address: anAddressOop [ - - "IPv4 Addresses are represented by an object with a smallinteger saying the address type (2 for IPv4), a 4 bytes bytearray as second instance variable, and a smallInteger as port number as third instance variable. If it does not have port the value is -1. - It returns the int32 representing the address in host order" - - - - - | ptrToByteArray | - ptrToByteArray := interpreterProxy firstIndexableField: (interpreterProxy fetchPointer: 1 ofObject: anAddressOop). - - ^ (ptrToByteArray at: 3 ) + - ((ptrToByteArray at: 2) <<8) + - ((ptrToByteArray at: 1) <<16) + - ((ptrToByteArray at: 0) <<24) - - -] - -{ #category : #'accessing - ip4' } -SocketPlugin >> getIp4Port: anAddressOop [ - - - - "IPv4 Addresses are represented by an object with a smallinteger saying the address type (2 for IPv4), a 4 bytes bytearray as second instance variable, and a smallInteger as port number as third instance variable. If it does not have port the value is -1. - It returns the int32 representing the port in host order" - - ^ interpreterProxy fetchInteger: 2 ofObject: anAddressOop -] - { #category : #'initialize-release' } SocketPlugin >> initialiseModule [ @@ -146,44 +61,6 @@ SocketPlugin >> intToNetAddress: addr [ ^ netAddressOop ] -{ #category : #'accessing - ip4' } -SocketPlugin >> ip4AddressType [ - - - - ^ 2 -] - -{ #category : #'accessing - ip4' } -SocketPlugin >> isValidIp4Address: anAddressOop [ - - - - "IPv4 Addresses are represented by an object with a smallinteger saying the address type (2 for IPv4), a 4 bytes bytearray as second instance variable, and a smallInteger as port number as third instance variable. If it does not have port the value is -1." - - | maybeByteArray maybeInteger type | - - type := self getAddressType: anAddressOop. - interpreterProxy failed ifTrue: [ ^ false ]. - - type = self ip4AddressType ifFalse: [ interpreterProxy primitiveFail. ^ false ]. - - maybeByteArray := interpreterProxy fetchPointer: 1 ofObject: anAddressOop. - - (interpreterProxy isBytes: maybeByteArray) - ifFalse: [ interpreterProxy primitiveFail. ^ false ]. - - (interpreterProxy stSizeOf: maybeByteArray) = 4 - ifFalse: [ interpreterProxy primitiveFail. ^ false ]. - - maybeInteger := interpreterProxy fetchPointer: 2 ofObject: anAddressOop. - - (interpreterProxy isIntegerObject: maybeInteger) - ifFalse: [ interpreterProxy primitiveFail. ^ false ]. - - ^ true -] - { #category : #primitives } SocketPlugin >> netAddressToInt: ptrToByteArray [ "Convert the given internet network address (represented as a four-byte ByteArray) into a 32-bit integer. Fail if the given ptrToByteArray does not appear to point to a four-byte ByteArray." @@ -460,22 +337,16 @@ SocketPlugin >> primitiveResolverStatus [ SocketPlugin >> primitiveSocket: socket LocalAddress: socketAddressOop [ - - - | s addr addrSize | + | s | + self primitive: 'primitiveSocketLocalAddress' parameters: #(Oop Oop). s := self socketValueOf: socket. - addr := self addressStructFor: socketAddressOop. - addrSize := self addressStructSizeFor: socketAddressOop. - interpreterProxy failed ifFalse: [ - self socketLocalAddress: s _: addr _: addrSize. - self updateAddress: socketAddressOop from: addr. - self free: addr ]. + self socketLocalAddress: s _: socketAddressOop ]. ] @@ -483,53 +354,35 @@ SocketPlugin >> primitiveSocket: socket LocalAddress: socketAddressOop [ SocketPlugin >> primitiveSocket: socket RemoteAddress: socketAddressOop [ - - - | s addr addrSize | + | s | self primitive: 'primitiveSocketRemoteAddress' parameters: #(Oop Oop). s := self socketValueOf: socket. - - addr := self addressStructFor: socketAddressOop. - addrSize := self addressStructSizeFor: socketAddressOop. interpreterProxy failed - ifFalse: [ - self socketRemoteAddress: s _: addr _: addrSize. - self updateAddress: socketAddressOop from: addr. - self free: addr ]. + ifFalse: [ self socketRemoteAddress: s _: socketAddressOop ]. ] { #category : #'primitives - connection' } SocketPlugin >> primitiveSocket: socket bindTo: socketAddressOop [ - - - - | s addr addrSize | + | s | self primitive: 'primitiveSocketBindTo' parameters: #(#Oop #Oop). s := self socketValueOf: socket. - addr := self addressStructFor: socketAddressOop. - addrSize := self addressStructSizeFor: socketAddressOop. - interpreterProxy failed ifFalse: [ - self socketBindTo: s _: addr _: addrSize. - self free: addr]. + self socketBindTo: s _: socketAddressOop ]. ] { #category : #'primitives - connection' } SocketPlugin >> primitiveSocket: socket connectTo: socketAddressOop [ - | addrSize addr s | - - - + | s | @@ -537,12 +390,8 @@ SocketPlugin >> primitiveSocket: socket connectTo: socketAddressOop [ s := self socketValueOf: socket. - addr := self addressStructFor: socketAddressOop. - addrSize := self addressStructSizeFor: socketAddressOop. - interpreterProxy failed ifFalse: [ - self socket: s ConnectToAddress: addr Size: addrSize. - self free: addr]. + self socket: s ConnectToAddress: socketAddressOop ]. ] @@ -578,10 +427,7 @@ SocketPlugin >> primitiveSocket: socket getOptions: optionName [ { #category : #'primitives - connection' } SocketPlugin >> primitiveSocket: socket listenOn: socketAddressOop backLog: backlogSize [ - | addrSize addr s | - - - + | s | @@ -589,12 +435,8 @@ SocketPlugin >> primitiveSocket: socket listenOn: socketAddressOop backLog: back s := self socketValueOf: socket. - addr := self addressStructFor: socketAddressOop. - addrSize := self addressStructSizeFor: socketAddressOop. - interpreterProxy failed ifFalse: [ - self socketListenOn: s _: addr _: addrSize _: backlogSize. - self free: addr]. + self socketListenOn: s _: socketAddressOop _: backlogSize ]. ] @@ -649,9 +491,6 @@ SocketPlugin >> primitiveSocket: socket receiveUDPDataBuf: array start: startInd interpreterProxy success: (startIndex >= 1 and: [count >= 0 and: [startIndex + count - 1 <= (interpreterProxy slotSizeOf: array)]]). - addr := self addressStructFor: socketAddressOop. - addrSize := self addressStructSizeFor: socketAddressOop. - interpreterProxy failed ifFalse: ["Note: adjust bufStart for zero-origin indexing" arrayBase := self cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *'. @@ -659,11 +498,7 @@ SocketPlugin >> primitiveSocket: socket receiveUDPDataBuf: array start: startInd bytesReceived := self socketReceiveUDPData: s _: bufStart _: count * elementSize - _: addr - _: addrSize. - - self updateAddress: socketAddressOop from: addr. - self free: addr ]. + _: socketAddressOop]. ^ (bytesReceived // elementSize) asSmallIntegerObj ] @@ -698,7 +533,7 @@ SocketPlugin >> primitiveSocket: socket sendData: array start: startIndex count: { #category : #'primitives - sending/receiving' } SocketPlugin >> primitiveSocket: socket sendUDPData: array toAddress: socketAddressOop start: startIndex count: count [ - | s byteSize arrayBase bufStart bytesSent addr addrSize | + | s byteSize arrayBase bufStart bytesSent | @@ -719,11 +554,7 @@ SocketPlugin >> primitiveSocket: socket sendUDPData: array toAddress: socketAddr ifFalse: ["Note: adjust bufStart for zero-origin indexing" arrayBase := self cCoerce: (interpreterProxy firstIndexableField: array) to: 'char *'. bufStart := arrayBase + (startIndex - 1 * byteSize). - addr := self addressStructFor: socketAddressOop. - addrSize := self addressStructSizeFor: socketAddressOop. - - bytesSent := self socketSendUDPDataToAddress: s _: addr _: addrSize _: bufStart _: count * byteSize. - self free: addr]. + bytesSent := self socketSendUDPDataToAddress: s _: socketAddressOop _: bufStart _: count * byteSize ]. ^ (bytesSent // byteSize) asSmallIntegerObj @@ -893,22 +724,6 @@ SocketPlugin >> primitiveSocketError: socket [ ^err asSmallIntegerObj ] -{ #category : #'primitives - status' } -SocketPlugin >> primitiveSocketLocalAddressType: socket [ - - - - | s | - self primitive: 'primitiveSocketLocalAddressType' parameters: #(#Oop). - - s := self socketValueOf: socket. - - interpreterProxy failed ifFalse: [ - ^ (self socketLocalAddressType: s) asSmallIntegerObj ]. - - ^ 0 asSmallIntegerObj -] - { #category : #'primitives - sending/receiving' } SocketPlugin >> primitiveSocketReceiveDataAvailable: socket [ @@ -921,22 +736,6 @@ SocketPlugin >> primitiveSocketReceiveDataAvailable: socket [ ^dataIsAvailable asBooleanObj ] -{ #category : #'primitives - status' } -SocketPlugin >> primitiveSocketRemoteAddressType: socket [ - - - - | s | - self primitive: 'primitiveSocketRemoteAddressType' parameters: #(#Oop). - - s := self socketValueOf: socket. - - interpreterProxy failed ifFalse: [ - ^ (self socketRemoteAddressType: s) asSmallIntegerObj ]. - - ^ 0 asSmallIntegerObj -] - { #category : #'primitives - status' } SocketPlugin >> primitiveSocketSendDone: socket [ @@ -949,34 +748,6 @@ SocketPlugin >> primitiveSocketSendDone: socket [ ^done asBooleanObj ] -{ #category : #'accessing - ip4' } -SocketPlugin >> setIp4Address: anAddressOop value: addr [ - - - - - - | naPtr | - naPtr := interpreterProxy firstIndexableField: (interpreterProxy fetchPointer: 1 ofObject: anAddressOop). - naPtr at: 0 put: (self cCoerce: ((addr >> 24) bitAnd: 16rFF) to: 'char'). - naPtr at: 1 put: (self cCoerce: ((addr >> 16) bitAnd: 16rFF) to: 'char'). - naPtr at: 2 put: (self cCoerce: ((addr >> 8) bitAnd: 16rFF) to: 'char'). - naPtr at: 3 put: (self cCoerce: (addr bitAnd: 16rFF) to: 'char'). - -] - -{ #category : #'accessing - ip4' } -SocketPlugin >> setIp4Port: anAddressOop value: aPort [ - - - - - "IPv4 Addresses are represented by an object with a smallinteger saying the address type (2 for IPv4), a 4 bytes bytearray as second instance variable, and a smallInteger as port number as third instance variable. If it does not have port the value is -1." - - ^ interpreterProxy storeInteger: 2 ofObject: anAddressOop withValue: aPort - -] - { #category : #'initialize-release' } SocketPlugin >> shutdownModule [ @@ -984,21 +755,21 @@ SocketPlugin >> shutdownModule [ ] { #category : #'for - simulation' } -SocketPlugin >> socket: s ConnectToAddress: addr Size: addrSize [ +SocketPlugin >> socket: s ConnectToAddress: addressOop [ self subclassResponsibility ] { #category : #'for - simulation' } -SocketPlugin >> socketBindTo: s _: addr _: addrSize [ +SocketPlugin >> socketBindTo: s _: socketAddressOop [ self subclassResponsibility ] { #category : #'for - simulation' } -SocketPlugin >> socketListenOn: s _: addr _: addrSize _: backlogSize [ +SocketPlugin >> socketListenOn: s _: addressOop _: backlogSize [ self subclassResponsibility @@ -1050,18 +821,3 @@ SocketPlugin >> sqSocketDestroy: socketPtr [ self subclassResponsibility ] - -{ #category : #'accessing - ip4' } -SocketPlugin >> updateAddress: socketAddressOop from: addr [ - - - - - | addressType | - - addressType := self getAddressType: socketAddressOop. - addressType = 0 ifTrue: [ ^ self ]. - - addressType = self ip4AddressType - ifTrue: [ ^ self ip4UpdateAddress: socketAddressOop _: addr ]. -] From 0882f5d52cfa00a91a070816f982c15eb7e55076 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Wed, 22 Sep 2021 17:57:53 +0200 Subject: [PATCH 15/16] Improving the Socket implementation --- plugins/SocketPlugin/include/SocketPlugin.h | 6 +- .../SocketPlugin/include/SocketPluginImpl.h | 1 + plugins/SocketPlugin/src/SocketPluginImpl.c | 38 ++++-- plugins/SocketPlugin/src/nameResolverImpl.c | 108 ++++++++++++++---- 4 files changed, 116 insertions(+), 37 deletions(-) diff --git a/plugins/SocketPlugin/include/SocketPlugin.h b/plugins/SocketPlugin/include/SocketPlugin.h index 6cbb6e3792..adc4000fb0 100644 --- a/plugins/SocketPlugin/include/SocketPlugin.h +++ b/plugins/SocketPlugin/include/SocketPlugin.h @@ -55,9 +55,6 @@ void sqResolverGetNameInfoHostResultSize(char *name, sqInt nameSize); sqInt sqResolverGetNameInfoServiceSize(void); void sqResolverGetNameInfoServiceResultSize(char *name, sqInt nameSize); -sqInt sqResolverHostNameSize(void); -void sqResolverHostNameResultSize(char *name, sqInt nameSize); - void socketConnectToAddress(SocketPtr s, sqInt socketAddressOop); void socketListenOn(SocketPtr s, sqInt socketAddressOop, int backlogSize); void socketBindTo(SocketPtr s, sqInt socketAddressOop); @@ -67,6 +64,9 @@ sqInt socketReceiveUDPData(SocketPtr s, char *buf, sqInt bufSize, sqInt socketAd void socketLocalAddress(SocketPtr s, sqInt socketAddressOop); void socketRemoteAddress(SocketPtr s, sqInt socketAddressOop); +sqInt resolverLocalInterfaces(sqInt anArrayOop); +sqInt resolverLocalName(); + /* family */ #define SOCKET_FAMILY_UNSPECIFIED 0 diff --git a/plugins/SocketPlugin/include/SocketPluginImpl.h b/plugins/SocketPlugin/include/SocketPluginImpl.h index 78c0d2f950..1c778f58cf 100644 --- a/plugins/SocketPlugin/include/SocketPluginImpl.h +++ b/plugins/SocketPlugin/include/SocketPluginImpl.h @@ -111,3 +111,4 @@ void nameResolverFini(); void updateAddressObject(sqInt socketAddressOop, struct sockaddr_storage * sockaddr); void updateSockAddressStruct(sqInt socketAddressOop, struct sockaddr_storage * sockaddr); +socklen_t sockAddressStructSize(struct sockaddr_storage* saddr); diff --git a/plugins/SocketPlugin/src/SocketPluginImpl.c b/plugins/SocketPlugin/src/SocketPluginImpl.c index 6201499e19..db213f96e8 100644 --- a/plugins/SocketPlugin/src/SocketPluginImpl.c +++ b/plugins/SocketPlugin/src/SocketPluginImpl.c @@ -1081,7 +1081,7 @@ void sqSocketSetReusable(SocketPtr s) void socketListenOn(SocketPtr s, sqInt socketAddressOop, int backlogSize) { struct sockaddr_storage saddr; - socklen_t saddrSize = sizeof(struct sockaddr_in); + socklen_t saddrSize; int lastError; if (!socketValid(s)) @@ -1098,6 +1098,8 @@ void socketListenOn(SocketPtr s, sqInt socketAddressOop, int backlogSize) { return; } + saddrSize = sockAddressStructSize(&saddr); + PSP(s)->multiListen = (backlogSize > 1); logTrace("listenOnPortBacklogSize(%d, %ld)\n", SOCKET(s), backlogSize); @@ -1121,7 +1123,7 @@ void socketListenOn(SocketPtr s, sqInt socketAddressOop, int backlogSize) { void socketBindTo(SocketPtr s, sqInt socketAddressOop) { struct sockaddr_storage saddr; - socklen_t saddrSize = sizeof(struct sockaddr_in); + socklen_t saddrSize; privateSocketStruct *pss = PSP(s); @@ -1131,6 +1133,8 @@ void socketBindTo(SocketPtr s, sqInt socketAddressOop) { } updateSockAddressStruct(socketAddressOop, &saddr); + saddrSize = sockAddressStructSize(&saddr); + if(interpreterProxy->failed()){ return; } @@ -1150,7 +1154,7 @@ void socketConnectToAddress(SocketPtr s, sqInt socketAddressOop){ */ struct sockaddr_storage saddr; - socklen_t saddrSize = sizeof(struct sockaddr_in); + socklen_t saddrSize; if (!socketValid(s)) { @@ -1165,6 +1169,8 @@ void socketConnectToAddress(SocketPtr s, sqInt socketAddressOop){ return; } + saddrSize = sockAddressStructSize(&saddr); + if (TCPSocketType != s->socketType) { /* --- UDP/RAW --- */ @@ -1216,7 +1222,7 @@ void socketConnectToAddress(SocketPtr s, sqInt socketAddressOop){ sqInt socketSendUDPDataToAddress(SocketPtr s, sqInt socketAddressOop, char* buffer, size_t bufferLength) { struct sockaddr_storage saddr; - socklen_t saddrSize = sizeof(struct sockaddr_in); + socklen_t saddrSize; if (socketValid(s) && (TCPSocketType != s->socketType)) { @@ -1225,6 +1231,8 @@ sqInt socketSendUDPDataToAddress(SocketPtr s, sqInt socketAddressOop, char* buff return 0; } + saddrSize = sockAddressStructSize(&saddr); + logTrace("sendTo(%d)\n", SOCKET(s)); int nsent = sendto(SOCKET(s), buffer, bufferLength, 0, (struct sockaddr *)&saddr, saddrSize); @@ -1248,7 +1256,7 @@ sqInt socketSendUDPDataToAddress(SocketPtr s, sqInt socketAddressOop, char* buff sqInt socketReceiveUDPData(SocketPtr s, char *buf, sqInt bufSize, sqInt socketAddressOop) { int lastError; struct sockaddr_storage saddr; - socklen_t saddrSize = sizeof(struct sockaddr_in); + socklen_t saddrSize = sizeof(struct sockaddr_storage); if (socketValid(s) && (TCPSocketType != s->socketType)) /* --- UDP/RAW --- */ { @@ -1275,7 +1283,7 @@ sqInt socketReceiveUDPData(SocketPtr s, char *buf, sqInt bufSize, sqInt socketAd void socketLocalAddress(SocketPtr s, sqInt socketAddressOop){ struct sockaddr_storage sockaddr; - socklen_t socklen = sizeof(struct sockaddr_in); + socklen_t socklen = sizeof(struct sockaddr_storage); if(!socketValid(s)) { @@ -1298,7 +1306,7 @@ void socketLocalAddress(SocketPtr s, sqInt socketAddressOop){ void socketRemoteAddress(SocketPtr s, sqInt socketAddressOop){ struct sockaddr_storage sockaddr; - socklen_t socklen = sizeof(struct sockaddr_in); + socklen_t socklen = sizeof(struct sockaddr_storage); if(!socketValid(s)) { @@ -1338,7 +1346,7 @@ void socketRemoteAddress(SocketPtr s, sqInt socketAddressOop){ * Addresses are represented by an object with: * * - A SmallInteger to identify the type of address (check translateSocketType to know the valid values) - * - A ByteArray with the address information if it is a IPv4 or IPv6, and a byteString if it is a unix socket + * - A ByteArray with the address information if it is a IPv4 or IPv6, and a byteArray encoded in utf8 if it is a unix socket * - A SmallInteger with the port (if non unix address). */ @@ -1397,10 +1405,10 @@ void updateAddressObject(sqInt socketAddressOop, struct sockaddr_storage * socka switch(sockaddr->ss_family){ case AF_UNIX: - addressInformation = interpreterProxy->instantiateClassindexableSize(interpreterProxy->classString(), addressLength); + addressInformation = interpreterProxy->instantiateClassindexableSize(interpreterProxy->classByteArray(), addressLength); if(interpreterProxy->failed()){ - logDebug("Cannot allocate string of size %d", addressLength); + logDebug("Cannot allocate ByteArray of size %d", addressLength); return; } @@ -1517,3 +1525,13 @@ void updateSockAddressStruct(sqInt socketAddressOop, struct sockaddr_storage * s return; } } + +socklen_t sockAddressStructSize(struct sockaddr_storage* saddr){ + switch(saddr->ss_family){ + case AF_UNIX: return sizeof(struct sockaddr_un); + case AF_INET: return sizeof(struct sockaddr_in); + case AF_INET6: return sizeof(struct sockaddr_in6); + default: + return -1; + } +} diff --git a/plugins/SocketPlugin/src/nameResolverImpl.c b/plugins/SocketPlugin/src/nameResolverImpl.c index ae41f8648b..353c161e26 100644 --- a/plugins/SocketPlugin/src/nameResolverImpl.c +++ b/plugins/SocketPlugin/src/nameResolverImpl.c @@ -517,30 +517,6 @@ void sqResolverGetNameInfoServiceResultSize(char *name, sqInt nameSize) } -sqInt sqResolverHostNameSize(void) -{ - char buf[MAXHOSTNAMELEN+1]; - if (gethostname(buf, sizeof(buf))) - { - success(false); - return 0; - } - return strlen(buf); -} - - -void sqResolverHostNameResultSize(char *name, sqInt nameSize) -{ - char buf[MAXHOSTNAMELEN+1]; - int len; - if (gethostname(buf, sizeof(buf)) || (nameSize < (len= strlen(buf)))) - { - success(false); - return; - } - memcpy(name, buf, len); -} - void nameResolverInit(sqInt resolverSemaIndex){ gethostname(localHostName, MAXHOSTNAMELEN); localHostAddress = nameToAddr(localHostName); @@ -550,3 +526,87 @@ void nameResolverInit(sqInt resolverSemaIndex){ void nameResolverFini(){ resolverSema = 0; } + +sqInt resolverLocalName() { + char hostName[MAXHOSTNAMELEN]; + + if(gethostname(hostName, MAXHOSTNAMELEN) == -1){ + success(false); + return interpreterProxy->nilObject(); + } + + sqInt hostNameLength = strlen(hostName); + + sqInt hostNameOop = interpreterProxy->instantiateClassindexableSize(interpreterProxy->classByteArray(), hostNameLength); + if(interpreterProxy->failed()){ + return interpreterProxy->nilObject(); + } + + memcpy(interpreterProxy->firstIndexableField(hostNameOop), hostName, hostNameLength); + + return hostNameOop; +} + +sqInt resolverLocalInterfaces(sqInt anArrayOop) { + +#ifndef _WIN32 + + struct ifaddrs *allInterfaces, *anInterface; + int s; + char host[NI_MAXHOST]; + sqInt localAddr = 0; + + sqInt index = 0; + sqInt anArraySize; + sqInt interfaceCount = 0; + + if (getifaddrs(&allInterfaces) == -1) { + success(false); + return 0; + } + + anArraySize = interpreterProxy->slotSizeOf(anArrayOop); + + anInterface = allInterfaces; + + while(anInterface != NULL){ + + if(index < anArraySize){ + + sqInt anInterfaceOop = interpreterProxy->fetchPointerofObject(index, anArrayOop); + sqInt interfaceNameSize = strlen(anInterface->ifa_name); + sqInt interfaceNameOop = interpreterProxy->instantiateClassindexableSize(interpreterProxy->classByteArray(), interfaceNameSize); + + if(interpreterProxy->failed()){ + logWarn("Cannot Allocate memory for instantiating a ByteArray of %d", interfaceNameSize); + success(false); + return 0; + } + + memcpy(interpreterProxy->firstIndexableField(interfaceNameOop), anInterface->ifa_name, interfaceNameSize); + + interpreterProxy->storePointerofObjectwithValue(0, anInterfaceOop, interfaceNameOop); + + if(anInterface->ifa_addr){ + updateAddressObject(interpreterProxy->fetchPointerofObject(1, anInterfaceOop), (struct sockaddr_storage *) anInterface->ifa_addr); + } + + if(anInterface->ifa_netmask){ + updateAddressObject(interpreterProxy->fetchPointerofObject(2, anInterfaceOop), (struct sockaddr_storage *) anInterface->ifa_netmask); + } + + index ++; + } + + interfaceCount ++; + anInterface = anInterface->ifa_next; + } + + freeifaddrs(allInterfaces); + + return interfaceCount; +#else + success(false); + return 0; +#endif +} From 37b0763687d589db333ac174e1089bcd6673ae17 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Tue, 16 May 2023 15:18:31 +0200 Subject: [PATCH 16/16] Adding missing functions in nameResolver --- plugins/SocketPlugin/include/SocketPlugin.h | 3 +++ plugins/SocketPlugin/src/nameResolverImpl.c | 16 ++++++++++++++++ 2 files changed, 19 insertions(+) diff --git a/plugins/SocketPlugin/include/SocketPlugin.h b/plugins/SocketPlugin/include/SocketPlugin.h index adc4000fb0..4861b86620 100644 --- a/plugins/SocketPlugin/include/SocketPlugin.h +++ b/plugins/SocketPlugin/include/SocketPlugin.h @@ -49,6 +49,9 @@ sqInt sqResolverGetAddressInfoType(void); sqInt sqResolverGetAddressInfoProtocol(void); sqInt sqResolverGetAddressInfoNext(void); +sqInt sqResolverHostNameSize(void); +void sqResolverHostNameResultSize(char *name, sqInt nameSize); + void sqResolverGetNameInfoSizeFlags(char *addr, sqInt addrSize, sqInt flags); sqInt sqResolverGetNameInfoHostSize(void); void sqResolverGetNameInfoHostResultSize(char *name, sqInt nameSize); diff --git a/plugins/SocketPlugin/src/nameResolverImpl.c b/plugins/SocketPlugin/src/nameResolverImpl.c index 353c161e26..1f23272b51 100644 --- a/plugins/SocketPlugin/src/nameResolverImpl.c +++ b/plugins/SocketPlugin/src/nameResolverImpl.c @@ -116,6 +116,22 @@ sqInt sqResolverStatus(void) /*** trivialities ***/ +sqInt sqResolverHostNameSize(void){ return strlen(localHostName); } + +void sqResolverHostNameResultSize(char *name, sqInt nameSize){ + int len; + + len = strlen(localHostName); + + if (nameSize < len){ + success(false); + return; + } + + memcpy(name, localHostName, len); +} + + sqInt sqResolverAddrLookupResultSize(void) { return strlen(lastName); } sqInt sqResolverError(void) { return lastError; } sqInt sqResolverLocalAddress(void) {