C/C++ porting, QTX and general status
C is a language that I used to play around with a lot back in the Amiga days. I think the last time I used a C compiler to write a library must have been in 1992 or something like that? I held on to my Amiga 1200 for as long as i could – but having fallen completely in love with Pascal, I eventually switched to x86 and went down the Turbo Pascal road.
Lately however, C++ developers have been asking for their own Developer group on Facebook. I run several groups on Facebook in the so-called “developer” family. So you have Delphi Developer, FPC Developer, Node.JS Developer and now – C++Builder developer. The groups more or less tend to themselves, and the node.js and FPC groups are presently being seeded (meaning, that the member count is being grown for a period).
The C++Builder group however, is having the same activity level as the Delphi group almost, thanks to some really good developers that post links, tips and help solve questions. I was also fortunate enough to have David Millington come on the Admin team. David is leading the C++Builder project, so his insight and knowledge of both language and product is exemplary. Just like Jim McKeeth, he is a wonderful resource for the community and chime in with answers to tricky questions whenever he has time to spare.
Getting back in the saddle
Having working some 30 years with Pascal and Object Pascal, 25 of those years in Delphi, C/C++ is never far away. I have an article on the subject that i’ve written for the Idera Community website, so I wont dig too deep into that here — but needless to say, Rad Studio consists of two languages: Object Pascal and C/C++, so no matter how much you love either language, the other is never far away.
So I figured it was time for this old dog to learn some new tricks! I have always said that it’s wise to learn a language immediately below and above your comfort zone. So if Delphi is your favorite language, then C/C++ is below you (meaning: more low level and complex). Above you are languages like JavaScript and C#. Learning JavaScript makes strategic sense (or use DWScript to compile Pascal to JavaScript like I do).
When I started out, the immediate language below Object Pascal was never C, but assembler. So for the longest time I turned to assembler whenever I needed a speed boost; graphics manipulation and processing pixels is especially a field where assembly makes all the difference.
But since C++Builder is indeed an integral part of Rad Studio, and Object Pascal and C/C++ so intimately connected (they have evolved side by side), why not enjoy both assembly and C right?
So I decided to jump back into the saddle and see what I could make of it.
C/C++ is not as hard as you think

I’m having a ball writing C/C++, and just like Delphi – you can start where you are.
While I’m not going to rehash the article I have already prepared for the Idera Community pages here, I do want to encourage people to give it a proper try. I have always said that if you know an archetypal language, you can easily pick up other languages, because the archetypal languages will benefit you for a lifetime. This has to do with archetypal languages operating according to how computers really work; as opposed to optimistic languages (a term from the DB work, optimistic locking), also called contextual languages, like C#, Java, JavaScript etc. are based on how human beings would like things to be.
So I now had a chance to put my money where my mouth is.
When I left C back in the early 90s, I never bothered with OOP. I mean, I used C purely for shared libraries anyways, while the actual programs were done in Pascal or a hybrid language called Blitz Basic. The latter compiled to razor sharp machine code, and you could use inline assembly – which I used a lot back then (very few programmers on those machines went without assembler, it was almost given that you could use 68k in some capacity).
Without ruining the article about to be published, I had a great time with C++Builder. It took a few hours to get my bearings, but since both the VCL and FMX frameworks are there – you can approach C/C++ just like you would Object Pascal. So it’s a matter of getting an overview really.
Needless to say, I’ll be porting a fair share of my libraries to C/C++ when I have time (those that makes sense under that paradigme). It’s always good to push yourself and there are plenty of subtle differences that I found useful.
Quartex Media Desktop
When I last wrote about QTX we were nearing the completion of the FileSystem and Task Management service. The prototype had all its file-handling directly in the core service (or server) which worked just fine — but it was linked to the Smart Pascal RTL. It has taken time to write a new RTL + a full multi-user, platform independent service stack and desktop (phew!) but we are seeing progress!

The QTX Baseline backend services is now largely done
The filesystem service is now largely done! There are a few synchronous calls I want to get rid of, but thankfully my framework has both async and sync variations of all file procedures – so that is now finished.
To make that clearer: first I have to wrap and implement the functionality for the RTL. Once they are in the RTL, I can use those functions to build the service functions. So yeah, it’s been extremely elaborate — but thankfully it’s also become a rich, well organized codebase (both the RTL and the Quartex Media Desktop codebases) – so I think we are ready to get cracking on the core!
The core is still operating with the older API. So our next step is to remove that from the core and instead delegate calls to the filesystem to our new service. So the core will simply be reduced to a post-office or traffic officer if you like. Messages come in from the desktops, and the core delegates the messages to whatever service is in charge of them.
But, this also means that both the core and the desktop must use the new and fancy messages. And this is where I did something very clever.
While I was writing the service, I also write a client class to test (obviously). And the way the core works — means that the same client that the core use to talk to the services — can be used by the desktop as well.
So our work in the desktop to get file-access and drives running again, is to wrap the client in our TQTXDevice ancestor class. The desktop NEVER accesses the API directly. All it knows about are these device drivers (or object instances). Which is how we solve things like DropBox and Google Drive support. The desktop wont have the faintest clue that its using Dropbox, or copying files between a local disk and Google Drive for example — because it only communicates with these device classes.
Recursive stuff
One thing that sucked about node.js function for deleting a folder, is that it’s recursive parameter doesn’t work on Windows or OS X. So I had to implement a full recursive deletefolder routine manually. Not a big thing, but slightly more painful than expected under asynchronous execution. Thankfully, Object Pascal allows for inline defined procedures, so I didn’t have to isolate it in a separate class.
Here is some of the code, a tiny spec compared to the full shabam, but it gives you an idea of what life is like under async conditions:
unit service.file.core; interface {.$DEFINE DEBUG} const CNT_PREFS_DEFAULTPORT = 1883; CNT_PREFS_FILENAME = 'QTXTaskManager.preferences.ini'; CNT_PREFS_DBNAME = 'taskdata.db'; CNT_ZCONFIG_SERVICE_NAME = 'TaskManager'; uses qtx.sysutils, qtx.json, qtx.db, qtx.logfile, qtx.orm, qtx.time, qtx.node.os, qtx.node.sqlite3, qtx.node.zconfig, qtx.node.cluster, qtx.node.core, qtx.node.filesystem, qtx.node.filewalker, qtx.fileapi.core, qtx.network.service, qtx.network.udp, qtx.inifile, qtx.node.inifile, NodeJS.child_process, ragnarok.types, ragnarok.Server, ragnarok.messages.base, ragnarok.messages.factory, ragnarok.messages.network, service.base, service.dispatcher, service.file.messages; type TQTXTaskServiceFactory = class(TMessageFactory) protected procedure RegisterIntrinsic; override; end; TQTXFileWriteCB = procedure (TagValue: variant; Error: Exception); TQTXFileStateCB = procedure (TagValue: variant; Error: Exception); TQTXUnRegisterLocalDeviceCB = procedure (TagValue: variant; DiskName: string; Error: Exception); TQTXRegisterLocalDeviceCB = procedure (TagValue: variant; LocalPath: string; Error: Exception); TQTXFindDeviceCB = procedure (TagValue: variant; Device: JDeviceInfo; Error: Exception); TQTXGetDisksCB = procedure (TagValue: variant; Devices: JDeviceList; Error: Exception); TQTXGetFileInfoCB = procedure (TagValue: variant; LocalName: string; Info: JStats; Error: Exception); TQTXGetTranslatePathCB = procedure (TagValue: variant; Original, Translated: string; Error: Exception); TQTXCheckDevicePathCB = procedure (TagValue: variant; PathName: string; Error: Exception); TQTXServerExecuteCB = procedure (TagValue: variant; Data: string; Error: Exception); TQTXTaskService = class(TRagnarokService) private FPrefs: TQTXIniFile; FLog: TQTXLogEmitter; FDatabase: TSQLite3Database; FZConfig: TQTXZConfigClient; FRegHandle: TQTXDispatchHandle; FRegCount: integer; procedure HandleGetDevices(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); procedure HandleGetDeviceByName(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); procedure HandleCreateLocalDevice(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); procedure HandleDestroyDevice(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); procedure HandleFileRead(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); procedure HandleFileReadPartial(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); procedure HandleGetFileInfo(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); procedure HandleFileDelete(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); procedure HandleFileWrite(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); procedure HandleFileWritePartial(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); procedure HandleFileRename(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); procedure HandleGetDir(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); procedure HandleMkDir(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); procedure HandleRmDir(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); procedure ExecuteExternalJS(Params: array of string; TagValue: variant; const CB: TQTXServerExecuteCB); procedure SendError(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage; Message: string); protected function GetFactory: TMessageFactory; override; procedure SetupPreferences(const CB: TRagnarokServiceCB); procedure SetupLogfile(LogFileName: string;const CB: TRagnarokServiceCB); procedure SetupDatabase(const CB: TRagnarokServiceCB); procedure ValidateLocalDiskName(TagValue: variant; Username, DeviceName: string; CB: TQTXCheckDevicePathCB); procedure RegisterLocalDevice(TagValue: variant; Username, DiskName: string; CB: TQTXRegisterLocalDeviceCB); procedure UnRegisterLocalDevice(TagValue: variant; UserName, DiskName:string; CB: TQTXUnRegisterLocalDeviceCB); procedure GetDevicesForUser(TagValue: variant; UserName: string; CB: TQTXGetDisksCB); procedure FindDeviceByName(TagValue: variant; UserName, DiskName: string; CB: TQTXFindDeviceCB); procedure FindDeviceByType(TagValue: variant; UserName: string; &Type: JDeviceType; CB: TQTXGetDisksCB); procedure GetTranslatedPathFor(TagValue: variant; Username, FullPath: string; CB: TQTXGetTranslatePathCB); procedure GetFileInfo(TagValue: variant; UserName: string; FullPath: string; CB: TQTXGetFileInfoCB); procedure SetupTaskTable(const TagValue: variant; const CB: TRagnarokServiceCB); procedure SetupOperationsTable(const TagValue: variant; const CB: TRagnarokServiceCB); procedure SetupDeviceTable(const TagValue: variant; const CB: TRagnarokServiceCB); procedure AfterServerStarted; override; procedure BeforeServerStopped; override; procedure Dispatch(Socket: TNJWebSocketSocket; Message: TQTXBaseMessage); override; public property Preferences: TQTXIniFile read FPrefs; property Database: TSQLite3Database read FDatabase; procedure SetupService(const CB: TRagnarokServiceCB); constructor Create; override; destructor Destroy; override; end; implementation //############################################################################# // TQTXFileenticationFactory //############################################################################# procedure TQTXTaskServiceFactory.RegisterIntrinsic; begin writeln("Registering task interface"); &Register(TQTXFileGetDeviceListRequest); &Register(TQTXFileGetDeviceByNameRequest); &Register(TQTXFileCreateLocalDeviceRequest); &Register(TQTXFileDestroyDeviceRequest); &Register(TQTXFileReadPartialRequest); &Register(TQTXFileReadRequest); &Register(TQTXFileWritePartialRequest); &Register(TQTXFileWriteRequest); &Register(TQTXFileDeleteRequest); &Register(TQTXFileRenameRequest); &Register(TQTXFileInfoRequest); &Register(TQTXFileDirRequest); &Register(TQTXMkDirRequest); &Register(TQTXRmDirRequest); &Register(TQTXFileRenameRequest); &Register(TQTXFileDirRequest); end; //############################################################################# // TQTXTaskService //############################################################################# constructor TQTXTaskService.Create; begin inherited Create; FPrefs := TQTXIniFile.Create(); FLog := TQTXLogEmitter.Create(); FDatabase := TSQLite3Database.Create(nil); FZConfig := TQTXZConfigClient.Create(); FZConfig.Port := 2292; self.OnUserSignedOff := procedure (Sender: TObject; Username: string) begin WriteToLogF("We got a service signal! User [%s] has signed off completely", [Username]); end; MessageDispatch.RegisterMessage(TQTXFileGetDeviceListRequest, @HandleGetDevices); MessageDispatch.RegisterMessage(TQTXFileGetDeviceByNameRequest, @HandleGetDeviceByName); MessageDispatch.RegisterMessage(TQTXFileCreateLocalDeviceRequest, @HandleCreateLocalDevice); MessageDispatch.RegisterMessage(TQTXFileDestroyDeviceRequest, @HandleDestroyDevice); MessageDispatch.RegisterMessage(TQTXFileReadRequest, @HandleFileRead); MessageDispatch.RegisterMessage(TQTXFileReadPartialRequest, @HandleFileReadPartial); MessageDispatch.RegisterMessage(TQTXFileWriteRequest, @HandleFileWrite); MessageDispatch.RegisterMessage(TQTXFileWritePartialRequest, @HandleFileWritePartial); MessageDispatch.RegisterMessage(TQTXFileInfoRequest, @HandleGetFileInfo); MessageDispatch.RegisterMessage(TQTXFileDeleteRequest, @HandleFileDelete); MessageDispatch.RegisterMessage(TQTXMkDirRequest, @HandleMkDir); MessageDispatch.RegisterMessage(TQTXRmDirRequest, @HandleRmDir); MessageDispatch.RegisterMessage(TQTXFileRenameRequest, @HandleFileRename); MessageDispatch.RegisterMessage(TQTXFileDirRequest, @HandleGetDir); end; destructor TQTXTaskService.Destroy; begin // decouple logger from our instance self.logging := nil; // Release prefs + log FPrefs.free; FLog.free; FZConfig.free; inherited; end; procedure TQTXTaskService.SendError(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage; Message: string); begin var reply := TQTXErrorMessage.Create(request.ticket); try reply.Code := CNT_MESSAGE_CODE_ERROR; reply.Routing.TagValue := Request.Routing.TagValue; reply.Response := Message; if Socket.ReadyState = rsOpen then begin try Socket.Send( reply.Serialize() ); except on e: exception do WriteToLog(e.message); end; end else WriteToLog("Failed to dispatch error, socket is closed error"); finally reply.free; end; end; procedure TQTXTaskService.ExecuteExternalJS(Params: array of string; TagValue: variant; const CB: TQTXServerExecuteCB); begin var LTask: JChildProcess; var lOpts := TVariant.CreateObject(); lOpts.shell := false; lOpts.detached := true; Params.insert(0, '--no-warnings'); // Spawn a new process, this creates a new shell interface try LTask := child_process().spawn('node', Params, lOpts ); except on e: exception do begin if assigned(CB) then CB(TagValue, e.message, e); exit; end; end; // Map general errors on process level LTask.on('error', procedure (error: variant) begin {$IFDEF DEBUG} writeln("error->" + error.toString()); {$ENDIF} WriteToLog(error.toString()); if assigned(CB) then CB(TagValue, "", nil); end); // map stdout so we capture the output LTask.stdout.on('data', procedure (data: variant) begin if assigned(CB) then CB(TagValue, data.toString(), nil); end); // map stderr so we can capture exception messages LTask.stderr.on('data', procedure (error:variant) begin {$IFDEF DEBUG} writeln("stdErr->" + error.toString()); {$ENDIF} if assigned(CB) then CB(TagValue, "", nil); WriteToLog(error.toString()); end); end; function TQTXTaskService.GetFactory: TMessageFactory; begin result := TQTXTaskServiceFactory.Create(); end; procedure TQTXTaskService.SetupService(const CB: TRagnarokServiceCB); begin SetupPreferences( procedure (Error: Exception) begin // No logfile yet setup (!) if Error nil then begin WriteToLog("Preferences setup: Failed!"); WriteToLog(error.message); raise error; end else WriteToLog("Preferences setup: OK"); // logfile-name is always relative to the executable var LLogFileName := TQTXNodeFileUtils.IncludeTrailingPathDelimiter( TQTXNodeFileUtils.GetCurrentDirectory ); LLogFileName += FPrefs.ReadString('log', 'logfile', 'log.txt'); // Port is defined in the ancestor, so we assigns it here Port := FPrefs.ReadInteger('networking', 'port', CNT_PREFS_DEFAULTPORT); SetupLogfile(LLogFileName, procedure (Error: Exception) begin if Error nil then begin WriteToLog("Logfile setup: Failed!"); WriteToLog(error.message); raise error; end else WriteToLog("Logfile setup: OK"); SetupDatabase( procedure (Error: Exception) begin if Error nil then begin WriteToLog("Database setup: Failed!"); WriteToLog(error.message); if assigned(CB) then CB(Error) else raise Error; end else WriteToLog("Database setup: OK"); if assigned(CB) then CB(nil); end); end); end); end; procedure TQTXTaskService.SetupPreferences(const CB: TRagnarokServiceCB); begin var lBasePath := TQTXNodeFileUtils.GetCurrentDirectory; var LPrefsFile := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(LBasePath) + CNT_PREFS_FILENAME; if TQTXNodeFileUtils.FileExists(LPrefsFile) then begin FPrefs.LoadFromFile(nil, LPrefsFile, procedure (TagValue: variant; Error: Exception) begin if Error nil then begin if assigned(CB) then CB(Error) else raise Error; exit; end; if assigned(CB) then CB(nil); end); end else begin var LError := Exception.Create('Could not locate preferences file: ' + LPrefsFile); WriteToLog(LError.message); if assigned(CB) then CB(LError) else raise LError; end; end; procedure TQTXTaskService.SetupLogfile(LogFileName: string;const CB: TRagnarokServiceCB); begin // Attempt to open logfile // Note: Log-object error options is set to throw exceptions try FLog.Open(LogFileName); except on e: exception do begin if assigned(CB) then begin CB(e); exit; end else begin writeln(e.message); raise; end; end; end; // We inherit from TQTXLogObject, which means we can pipe // all errors etc directly using built-in functions. So here // we simply glue our instance to the log-file, and its all good self.Logging := FLog as IQTXLogClient; if assigned(CB) then CB(nil); end; procedure TQTXTaskService.FindDeviceByType(TagValue: variant; UserName: string; &Type: JDeviceType; CB: TQTXGetDisksCB); begin UserName := username.trim().ToLower(); if Username.length < 1 then begin WriteToLog("Failed to lookup disk, username was invalid error"); var lError := EException.Create("Failed to lookup devices, invalid username"); if assigned(CB) then CB(TagValue, nil, lError) else raise lError; exit; end; GetDevicesForUser(TagValue, Username, procedure (TagValue: variant; Devices: JDeviceList; Error: Exception) begin if Error nil then begin if assigned(CB) then CB(TagValue, nil, Error) else raise Error; exit; end; var x := 0; while x < Devices.dlDrives.Count do begin if Devices.dlDrives[x].&Type &Type then begin Devices.dlDrives.delete(x, 1); continue; end; inc(x); end; if assigned(CB) then CB(TagValue, Devices, nil); end); end; procedure TQTXTaskService.FindDeviceByName(TagValue: variant; Username, DiskName: string; CB: TQTXFindDeviceCB); begin UserName := username.trim().ToLower(); if Username.length < 1 then begin var lLogText := "Failed to lookup device, username was invalid error"; WriteToLog(lLogText); var lError := EException.Create(lLogText); if assigned(CB) then CB(TagValue, nil, lError) else raise lError; exit; end; DiskName := DiskName.trim(); if DiskName.length < 1 then begin var lLogText := "Failed to lookup device, disk-name was invalid error"; WriteToLog(lLogText); var lError := EException.Create(lLogText); if assigned(CB) then CB(TagValue, nil, lError) else raise lError; exit; end; GetDevicesForUser(TagValue, Username, procedure (TagValue: variant; Devices: JDeviceList; Error: Exception) begin if Error nil then begin if assigned(CB) then CB(TagValue, nil, Error) else raise Error; exit; end; DiskName := DiskName.trim().ToLower(); var lDiskInfo: JDeviceInfo := nil; for var disk in Devices.dlDrives do begin if disk.Name.ToLower() = DiskName then begin lDiskInfo := disk; break; end; end; if assigned(CB) then CB(TagValue, lDiskInfo, nil); end); end; procedure TQTXTaskService.GetTranslatedPathFor(TagValue: variant; Username, FullPath: string; CB: TQTXGetTranslatePathCB); begin var lParser := TQTXPathParser.Create(); try var lInfo: TQTXPathData; if lparser.Parse(FullPath, lInfo) then begin // Locate the device for the path belonging to the user FindDeviceByName(TagValue, UserName, lInfo.MountPart, procedure (TagValue: variant; Device: JDeviceInfo; Error: Exception) begin if Error nil then begin if assigned(CB) then CB(TagValue, FullPath, '', Error) else raise Error; exit; end; if Device.&Type dtLocal then begin var lError := EException.CreateFmt('Failed to translate path, device [%s] is not local error', [Device.Name]); if assigned(CB) then CB(TagValue, FullPath, '', Error) else raise Error; exit; end; // We want the path + filename, so we can append that to // the actual localized filesystem var lExtract := FullPath; delete(lExtract, 1, lInfo.MountPart.Length + 1); // Construct complete storage location var lFullPath := TQTXNodeFileUtils.GetCurrentDirectory(); lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + 'userdevices'; lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + Device.location.trim(); lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + lExtract; // Return translated path if assigned(CB) then CB(TagValue, FullPath, lFullPath, nil); end); end else begin var lErr := EException.CreateFmt("Invalid path [%s] error", [FullPath]); if assigned(CB) then CB(TagValue, FullPath, '', lErr) else raise lErr; end; finally lParser.free; end; end; procedure TQTXTaskService.GetFileInfo(TagValue: variant; UserName, FullPath: string; CB: TQTXGetFileInfoCB); begin var lParser := TQTXPathParser.Create(); try var lInfo: TQTXPathData; if lparser.Parse(FullPath, lInfo) then begin // Locate the device for the path belonging to the user FindDeviceByName(TagValue, UserName, lInfo.MountPart, procedure (TagValue: variant; Device: JDeviceInfo; Error: Exception) begin if Error nil then begin if assigned(CB) then CB(TagValue, '', nil, Error) else raise Error; exit; end; case Device.&Type of dtLocal: begin // We want the path + filename, so we can append that to // the actual localized filesystem var lExtract := FullPath; delete(lExtract, 1, lInfo.MountPart.Length + 1); // Construct complete storage location var lFullPath := TQTXNodeFileUtils.GetCurrentDirectory(); lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + 'userdevices'; lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + Device.location.trim(); lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + lExtract; // Call the underlying OS to get the file statistics NodeJsFsAPI().lStat(lFullPath, procedure (Error: JError; Stats: JStats) begin if Error nil then begin var lError := EException.Create(Error.message); if assigned(CB) then CB(TagValue, lFullPath, nil, lError) else raise lError; exit; end; // And deliver if assigned(CB) then CB(TagValue, lFullPath, Stats, nil); end); end; dtDropbox, dtGoogle, dtMsDrive: begin var lError := EException.Create("Cloud bindings not activated error"); if assigned(CB) then CB(TagValue, '', nil, lError) end; end; end); end else begin var lErr := EException.CreateFmt("Invalid path [%s] error", [FullPath]); if assigned(CB) then CB(TagValue, '', nil, lErr) else raise lErr; end; finally lParser.free; end; end; procedure TQTXTaskService.GetDevicesForUser(TagValue: variant; Username: string; CB: TQTXGetDisksCB); begin UserName := username.trim().ToLower(); if Username.length < 1 then begin WriteToLog("Failed to lookup devices, username was invalid error"); var lError := EException.Create("Failed to lookup devices, invalid username"); if assigned(CB) then CB(TagValue, nil, lError) else raise lError; exit; end; var lTransaction: TQTXReadTransaction; if not TSQLite3Database(DataBase).CreateReadTransaction(lTransaction) then begin var lErr := EException.Create("Failed to create read-transaction error"); if assigned(cb) then CB(TagValue, nil, lErr) else raise lErr; exit; end; var lQuery := TSQLite3ReadTransaction(lTransaction); lQuery.SQL := "select * from devices where owner=?"; lQuery.Parameters.AddValueOnly(Username); lQuery.Execute( procedure (Sender: TObject; Error: Exception) begin if Error nil then begin if assigned(CB) then CB(TagValue, nil, Error) else raise Error; exit; end; var lDisks := new JDeviceList(); lDisks.dlUser := UserName; for var x := 0 to lQuery.datarows.length-1 do begin var lInfo := new JDeviceInfo(); lInfo.Name := lQuery.datarows[x]["name"]; lInfo.&Type := JDeviceType( lQuery.datarows[x]["type"] ); lInfo.owner := lQuery.datarows[x]["owner"]; lInfo.location := lQuery.datarows[x]["location"]; lInfo.APIKey := lQuery.datarows[x]["apikey"]; lInfo.APISecret := lQuery.datarows[x]["apisecret"]; lInfo.APIPassword := lQuery.datarows[x]["apipassword"]; lInfo.APIUser := lQuery.datarows[x]["apiuser"]; lDisks.dlDrives.add(lInfo); end; try if assigned(CB) then CB(TagValue, lDisks, nil); finally lQuery.free; end; end); end; procedure TQTXTaskService.ValidateLocalDiskName(TagValue: variant; Username, DeviceName: string; CB: TQTXCheckDevicePathCB); begin var Filename := 'disk.' + username + '.' + DeviceName + '.' + ord(JDeviceType.dtLocal).ToString(); var LBasePath := TQTXNodeFileUtils.GetCurrentDirectory(); LBasePath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(LBasePath) + 'userdevices'; // Make sure the device folder is there if not TQTXNodeFileUtils.DirectoryExists(LBasePath) then begin var lError := EException.CreateFmt("Directory not found: %s", [lBasePath]); if assigned(CB) then CB(TagValue, '', lError) else raise lError; exit; end; lBasePath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(LBasePath) + Filename; if TQTXNodeFileUtils.DirectoryExists(LBasePath) then begin var lError := EException.CreateFmt("Path already exist error [%s]", [lBasePath]); if assigned(CB) then CB(TagValue, '', lError) else raise lError; exit; end; // OK, folder is not created yet, so its good to go if assigned(CB) then CB(TagValue, Filename, nil); end; procedure TQTXTaskService.UnRegisterLocalDevice(TagValue: variant; UserName, DiskName: string; CB: TQTXUnRegisterLocalDeviceCB); begin WriteToLogF("Removing local device [%s] for user [%s] ", [DiskName, Username]); // Check username string UserName := username.trim().ToLower(); if Username.length < 1 then begin WriteToLog("Failed to unregister device, username was invalid error"); var lError := EException.Create("Failed to register device, invalid username"); if assigned(CB) then CB(TagValue, DiskName, lError) else raise lError; exit; end; // Check diskname string DiskName := DiskName.trim().ToLower(); if DiskName.length < 1 then begin WriteToLog("Failed to unregister device, disk-name was invalid error"); var lError := EException.Create("Failed to register device, invalid disk-name"); if assigned(CB) then CB(TagValue, DiskName, lError) else raise lError; exit; end; FindDeviceByName(TagValue, Username, DiskName, procedure (TagValue: variant; Device: JDeviceInfo; Error: Exception) begin // Did the search fail? if Error nil then begin WriteToLog(Error.message); if assigned(CB) then CB(TagValue, DiskName, Error) else raise Error; exit; end; // Make sure the device is local if Device.&Type dtLocal then begin var lError := EException.CreateFmt('Failed to translate path, device [%s] is not local error', [Device.Name]); if assigned(CB) then CB(TagValue, DiskName, Error) else raise Error; exit; end; // Delete record from database var lWriter: TQTXWriteTransaction; if FDatabase.CreateWriteTransaction(lWriter) then begin lWriter.SQL := "delete from profiles where user = ? and name = ?;"; lWriter.Parameters.AddValueOnly(Username); lWriter.Parameters.AddValueOnly(DiskName); lWriter.Execute( procedure (Sender: TObject; Error: Exception) begin try if Error nil then begin if assigned(CB) then CB(TagValue, DiskName, Error) else raise Error; exit; end; // Construct complete storage location var lFullPath := TQTXNodeFileUtils.GetCurrentDirectory(); lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + 'userdevices'; lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + Device.location.trim(); // Now delete the disk-drive directory TQTXNodeFileUtils.DeleteDirectory(nil, lFullPath, procedure (TagValue: variant; Path: string; Error: Exception) begin if assigned(CB) then CB(TagValue, DiskName, Error) end); finally lWriter.free; lWriter := nil; end; end); end; end); end; procedure TQTXTaskService.RegisterLocalDevice(TagValue: variant; Username, DiskName: string; CB: TQTXRegisterLocalDeviceCB); begin WriteToLogF("Adding local device [%s] for user [%s] ", [DiskName, Username]); UserName := username.trim().ToLower(); if Username.length < 1 then begin WriteToLog("Failed to register device, username was invalid error"); var lError := EException.Create("Failed to register device, invalid username"); if assigned(CB) then CB(TagValue, '', lError) else raise lError; exit; end; DiskName := DiskName.trim().ToLower(); if DiskName.length < 1 then begin WriteToLog("Failed to register device, disk-name was invalid error"); var lError := EException.Create("Failed to register device, invalid disk-name"); if assigned(CB) then CB(TagValue, '', lError) else raise lError; exit; end; FindDeviceByName(TagValue, Username, DiskName, procedure (TagValue: variant; Device: JDeviceInfo; Error: Exception) begin // Did the search fail? if Error nil then begin WriteToLog(Error.message); if assigned(CB) then CB(TagValue, '', Error) else raise Error; exit; end; // Does a device that match already exist? if Device nil then begin var lError := EException.CreateFmt("Failed to create device [%s], device already exists", [DiskName]); if assigned(CB) then CB(TagValue, '', lError) else raise lError; exit; end; // make sure the device-folder does not exist, so we can create it ValidateLocalDiskName(TagValue, Username, DiskName, procedure (TagValue: variant; PathName: string; Error: Exception) begin if Error nil then begin if assigned(CB) then CB(TagValue, '', Error) else raise Error; exit; end; // ValidateLocalDiskName only returns the valid directory-name, // not a full path -- so we need to build up the full targetpath var lFullPath := TQTXNodeFileUtils.GetCurrentDirectory(); lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + 'userdevices'; lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + PathName; TQTXNodeFileUtils.CreateDirectory(nil, lFullPath, procedure (TagValue: variant; Path: string; Error: exception) begin if Error nil then begin var lError := EException.CreateFmt("Failed to create device [%s] with path: %s", [DiskName, lFullPath]); if assigned(CB) then CB(TagValue, PathName, lError) else raise lError; exit; end; FDatabase.Execute( #'insert into devices (type, owner, name, location) values(?, ?, ?, ?);', [ord(JDeviceType.dtLocal), UserName, Diskname, PathName] , procedure (Sender: TObject; Error: Exception) begin if Error nil then begin WriteToLog(Error.message); if assigned(CB) then CB(TagValue, PathName, Error) else raise Error; exit; end; WriteToLogF("Device [%s] added to database user [%s]", [DiskName, UserName]); if assigned(CB) then CB(TagValue, PathName, nil); end); end); end); end); end; procedure TQTXTaskService.SetupDeviceTable(const TagValue: variant; const CB: TRagnarokServiceCB); begin FDatabase.Execute( #' create table if not exists devices ( id integer primary key AUTOINCREMENT, type integer, owner text, name text, location text, apikey text, apisecret text, apipassword text, apiuser text ); ', [], procedure (Sender: TObject; Error: Exception) begin if Error nil then begin WriteToLog(Error.message); if assigned(CB) then CB(Error) else raise Error; exit; end else if assigned(CB) then CB(nil); end); end; procedure TQTXTaskService.SetupTaskTable(const TagValue: variant; const CB: TRagnarokServiceCB); begin FDatabase.Execute( #' create table if not exists tasks ( id integer primary key AUTOINCREMENT, state integer, username text, created real ); ', [], procedure (Sender: TObject; Error: Exception) begin if Error nil then begin WriteToLog(Error.message); if assigned(CB) then CB(Error) else raise Error; exit; end else if assigned(CB) then CB(nil); end); end; procedure TQTXTaskService.SetupOperationsTable(const TagValue: variant; const CB: TRagnarokServiceCB); begin FDatabase.Execute( #' create table if not exists operations ( id integer primary key AUTOINCREMENT, username text, taskid integer, name text, filename text ); ', [], procedure (Sender: TObject; Error: Exception) begin if Error nil then begin WriteToLog(Error.message); if assigned(CB) then CB(Error) else raise Error; exit; end else if assigned(CB) then CB(nil); end); end; procedure TQTXTaskService.SetupDatabase(const CB: TRagnarokServiceCB); begin // Try to read database-path from preferences file var LDbFileToOpen := FPrefs.ReadString("database", "database_name", ""); // Trim away spaces, check if there is a filename LDbFileToOpen := LDbFileToOpen.trim(); if LDbFileToOpen.length < 1 then begin // No filename? Fall back on pre-defined file in CWD var LBasePath := TQTXNodeFileUtils.GetCurrentDirectory(); LDbFileToOpen := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(LBasePath) + CNT_PREFS_DBNAME; end; FDatabase.AccessMode := TSQLite3AccessMode.sqaReadWriteCreate; FDatabase.Open(LDbFileToOpen, procedure (Sender: TObject; Error: Exception) begin if Error nil then begin WriteToLog(Error.message); if assigned(CB) then CB(Error) else raise Error; exit; end; WriteToLog("Initializing task table"); SetupTaskTable(nil, procedure (Error: exception) begin if Error nil then begin WriteToLog("Tasks initialized: **failed"); WriteToLog(error.message); if assigned(CB) then CB(Error) else raise Error; exit; end else writeToLog("Tasks initialized: OK"); WriteToLog("Initializing operations table"); SetupOperationsTable(nil, procedure (Error: exception) begin if Error nil then begin WriteToLog("Operations initialized: **failed"); WriteToLog(error.message); if assigned(CB) then CB(Error); exit; end else writeToLog("Operations initialized: OK"); WriteToLog("Initializing device table"); SetupDeviceTable(nil, procedure (Error: exception) begin if Error nil then begin WriteToLog("Device-table initialized: **failed"); WriteToLog(error.message); if assigned(CB) then CB(Error); exit; end else writeToLog("Device-table initialized: OK"); if assigned(CB) then CB(nil); end); end); end); end); end; procedure TQTXTaskService.HandleFileRead(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); begin var lRequest := TQTXFileReadRequest(request); var lUserName := lRequest.UserName; var lFileName := lRequest.FileName; // Check filename length if lFileName.length 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; lTemp := './'; if pos(lTemp, lFileName) > 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; GetFileInfo(lRequest, lUserName, lFileName, procedure (TagValue: variant; LocalFile: string; Info: JStats; Error: Exception) begin if Error nil then begin WriteToLog(Error.message); SendError(Socket, Request, Error.Message); exit; end; var lOptions: TReadFileOptions; lOptions.encoding := 'binary'; NodeJsFsAPI().readFile(LocalFile, lOptions, procedure (Error: JError; Data: JNodeBuffer) begin if Error nil then begin WriteToLog(Error.message); SendError(Socket, Request, Error.Message); exit; end; var lResponse := TQTXFileReadResponse.Create(Request.Ticket); lResponse.UserName := lUserName; lResponse.Routing.TagValue := request.routing.tagValue; lResponse.FileName := lFileName; lResponse.Code := CNT_MESSAGE_CODE_OK; lResponse.Response := CNT_MESSAGE_TEXT_OK; // Convert filedata in one pass try var lConvert := TDataTypeConverter.Create(); try lResponse.Attachment.AppendBytes( lConvert.TypedArrayToBytes(Data) ); finally lConvert.free; end; except on e: exception do begin WriteToLog(e.message); SendError(Socket, Request, e.Message); exit; end; end; try Socket.Send( lResponse.Serialize() ); except on e: exception do WriteToLog(e.message); end; end); end); end; procedure TQTXTaskService.HandleFileReadPartial(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); begin var lRequest := TQTXFileReadPartialRequest(request); var lUserName := lRequest.UserName; var lFileName := lRequest.FileName; var lStart := lRequest.Offset; var lSize := lRequest.Size; // Check filename length if lFileName.length 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; lTemp := './'; if pos(lTemp, lFileName) > 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; if lSize < 1 then begin SendError(Socket, Request, "Read failed, invalid size error"); exit; end; if lStart < 0 then begin SendError(Socket, Request, "Read failed, invalid offset error"); exit; end; GetFileInfo(lRequest, lUserName, lFileName, procedure (TagValue: variant; LocalFile: string; Info: JStats; Error: Exception) begin if Error nil then begin WriteToLog(Error.message); SendError(Socket, Request, Error.Message); exit; end; if lStart > Info.size then begin SendError(Socket, Request, "Read failed, offset beyond filesize error"); exit; end; NodeJsFsAPI().open(LocalFile, "r", procedure (Error: JError; Fd: THandle) begin if error nil then begin WriteToLog(Error.message); SendError(Socket, Request, Error.Message); exit; end; var Data = new JNodeBuffer(lSize); NodeJsFsAPI().read(Fd, Data, 0, lSize, lStart, procedure (Error: JError; BytesRead: integer; buffer: JNodeBuffer) begin if Error nil then begin NodeJsFsAPI().closeSync(Fd); WriteToLog(Error.message); SendError(Socket, Request, Error.Message); exit; end; // Close the file-handle and return data NodeJsFsAPI().close(Fd, procedure (Error: JError) begin var lResponse := TQTXFileReadPartialResponse.Create(Request.Ticket); lResponse.UserName := lUserName; lResponse.Routing.TagValue := request.routing.tagValue; lResponse.FileName := lFileName; lResponse.Code := CNT_MESSAGE_CODE_OK; lResponse.Response := CNT_MESSAGE_TEXT_OK; // Only encode data if read if BytesRead > 0 then begin // Convert filedata in one pass try var lConvert := TDataTypeConverter.Create(); try lResponse.Attachment.AppendBytes( lConvert.TypedArrayToBytes(buffer) ); finally lConvert.free; end; except on e: exception do begin WriteToLog(e.message); SendError(Socket, Request, e.Message); exit; end; end; end; try Socket.Send( lResponse.Serialize() ); except on e: exception do WriteToLog(e.message); end; end); end); end); end); end; procedure TQTXTaskService.HandleFileWrite(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); begin var lRequest := TQTXFileWriteRequest(request); var lFileName := lRequest.FileName.trim(); var lUserName := lRequest.UserName.trim(); var FullPath := lFileName; // Check filename length if lFileName.length 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; lTemp := './'; if pos(lTemp, lFileName) > 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; var lParser := TQTXPathParser.Create(); try var lInfo: TQTXPathData; if lparser.Parse(FullPath, lInfo) then begin // Locate the device for the path belonging to the user FindDeviceByName(nil, lUserName, lInfo.MountPart, procedure (TagValue: variant; Device: JDeviceInfo; Error: Exception) begin if Error nil then begin WriteToLog(Error.Message); SendError(Socket, Request, Error.Message); exit; end; case Device.&Type of dtLocal: begin // We want the path + filename, so we can append that to // the actual localized filesystem var lExtract := FullPath; delete(lExtract, 1, lInfo.MountPart.Length + 1); // Construct complete storage location var lFullPath := TQTXNodeFileUtils.GetCurrentDirectory(); lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + 'userdevices'; lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + Device.location.trim(); lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + lExtract; // Extract data to be appended, if any // note: null bytes should be allowed, it should just create the file var lBytes: array of UInt8; if lRequest.attachment.Size > 0 then lBytes := lRequest.Attachment.ToBytes(); // Write the data to the file NodeJsFsAPI().writeFile(lFullPath, lBytes, procedure (Error: JError) begin if Error nil then begin WriteToLog(Error.Message); SendError(Socket, Request, Error.Message); exit; end; // Setup response object var lResponse := TQTXFileWriteResponse.Create(lRequest.Ticket); lResponse.UserName := lUserName; lResponse.FileName := lFileName; lResponse.Code := CNT_MESSAGE_CODE_OK; lResponse.Response := CNT_MESSAGE_TEXT_OK; // Send success response try Socket.Send( lResponse.Serialize() ); except on e: exception do WriteToLog(e.message); end; end); end; dtDropbox, dtGoogle, dtMsDrive: begin var lErrorText := Format("Clound bindings not active error [%s]", [lRequest.FileName]); WriteToLog(lErrorText); SendError(Socket, Request, lErrorText); end; end; end); end else begin SendError(Socket, Request, format("Invalid path [%s] error", [FullPath])); end; finally lParser.free; end; end; procedure TQTXTaskService.HandleFileWritePartial(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); begin var lRequest := TQTXFileWritePartialRequest(request); var lFileName := lRequest.FileName.trim(); var lUserName := lRequest.UserName.trim(); var lFileOffset := lRequest.Offset; // Check filename length if lFileName.length 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; lTemp := './'; if pos(lTemp, lFileName) > 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; var FullPath := lFileName; var lParser := TQTXPathParser.Create(); try var lInfo: TQTXPathData; if lparser.Parse(FullPath, lInfo) then begin // Locate the device for the path belonging to the user FindDeviceByName(nil, lUserName, lInfo.MountPart, procedure (TagValue: variant; Device: JDeviceInfo; Error: Exception) begin if Error nil then begin WriteToLog(Error.Message); SendError(Socket, Request, Error.Message); exit; end; case Device.&Type of dtLocal: begin // We want the path + filename, so we can append that to // the actual localized filesystem var lExtract := FullPath; delete(lExtract, 1, lInfo.MountPart.Length + 1); // Construct complete storage location var lFullPath := TQTXNodeFileUtils.GetCurrentDirectory(); lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + 'userdevices'; lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + Device.location.trim(); lFullPath := TQTXNodeFileUtils.IncludeTrailingPathDelimiter(lFullPath) + lExtract; // Extract data to be appended, if any // note: null bytes should be allowed, it should just create the file var lBytes: array of UInt8; if lRequest.attachment.Size > 0 then lBytes := lRequest.Attachment.ToBytes(); var lAccess := TQTXNodeFile.Create(); lAccess.Open(lFullPath, TQTXNodeFileMode.nfWrite, procedure (Error: Exception) begin if Error nil then begin WriteToLog(Error.Message); SendError(Socket, Request, Error.Message); exit; end; lAccess.Write(lBytes, lFileOffset, procedure (Error: Exception) begin if Error nil then begin WriteToLog(Error.Message); SendError(Socket, Request, Error.Message); exit; end; // Setup response object var lResponse := TQTXFileWriteResponse.Create(lRequest.Ticket); lResponse.UserName := lUserName; lResponse.FileName := lFileName; lResponse.Code := CNT_MESSAGE_CODE_OK; lResponse.Response := CNT_MESSAGE_TEXT_OK; // Send success response try Socket.Send( lResponse.Serialize() ); except on e: exception do WriteToLog(e.message); end; end); end); end; dtDropbox, dtGoogle, dtMsDrive: begin var lErrorText := Format("Clound bindings not active error [%s]", [lRequest.FileName]); WriteToLog(lErrorText); SendError(Socket, Request, lErrorText); end; end; end); end else begin SendError(Socket, Request, format("Invalid path [%s] error", [FullPath])); end; finally lParser.free; end; end; procedure TQTXTaskService.HandleRmDir(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); begin var lRequest := TQTXRmDirRequest(request); var lUserName := lRequest.UserName.trim(); var lDirPath := lRequest.DirPath.trim(); if lDirPath.length 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; lTemp := './'; if pos(lTemp, lDirPath) > 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; var lParser := TQTXPathParser.Create(); try var lInfo: TQTXPathData; if lParser.Parse(lDirPath, lInfo) then begin GetTranslatedPathFor(nil, lUserName, lDirPath, procedure (TagValue: variant; Original, Translated: string; Error: Exception) begin if Error nil then begin WriteToLog(Error.message); SendError(Socket, Request, Error.Message); exit; end; if not TQTXNodeFileUtils.DirectoryExists(Translated) then begin WriteToLogF("RmDir Failed, directory [%s] does not exist", [Translated]); SendError(Socket, Request, Format("RmDir failed, directory [%s] does not exist", [Original])); exit; end; TQTXNodeFileUtils.DeleteDirectory(nil, Translated, procedure (TagValue: variant; Path: string; Error: Exception) begin if error nil then begin WriteToLog(Error.message); SendError(Socket, Request, Error.Message); exit; end; // Setup response object var lResponse := TQTXRmDirResponse.Create(lRequest.Ticket); lResponse.UserName := lUserName; lResponse.DirPath := lDirPath; lResponse.Code := CNT_MESSAGE_CODE_OK; lResponse.Response := CNT_MESSAGE_TEXT_OK; lResponse.Routing.TagValue := lRequest.Routing.TagValue; // Send success response try Socket.Send( lResponse.Serialize() ); except on e: exception do WriteToLog(e.message); end; end); end); end else begin var lText := format("RmDir failed, invalid path [%s] error", [lDirPath]); WriteToLog(lText); SendError(Socket, Request, lText); end; finally lParser.free; end; end; procedure TQTXTaskService.HandleMkDir(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); begin var lRequest := TQTXMkDirRequest(request); var lUserName := lRequest.UserName.trim(); var lDirPath := lRequest.DirPath.trim(); if lDirPath.length 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; lTemp := './'; if pos(lTemp, lDirPath) > 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; var lParser := TQTXPathParser.Create(); try var lInfo: TQTXPathData; if lparser.Parse(lDirPath, lInfo) then begin GetTranslatedPathFor(nil, lUserName, lDirPath, procedure (TagValue: variant; Original, Translated: string; Error: Exception) begin if Error nil then begin WriteToLog(Error.message); SendError(Socket, Request, Error.Message); exit; end; TQTXNodeFileUtils.DirectoryExists(nil, Translated, procedure (TagValue: variant; Path: string; Error: Exception) begin if Error nil then begin WriteToLogF("MkDir Failed, directory [%s] already exists", [Translated]); SendError(Socket, Request, Format("MkDir Failed, directory [%s] already exists", [Original])); exit; end; TQTXNodeFileUtils.CreateDirectory(nil, Translated, procedure (TagValue: variant; Path: string; Error: Exception) begin if Error nil then begin WriteToLogF("MkDir Failed, directory [%s] could not be created", [Original]); SendError(Socket, Request, Format("MkDir Failed, directory [%s] could not be created", [Translated])); exit; end; // Setup response object var lResponse := TQTXMkDirResponse.Create(lRequest.Ticket); lResponse.UserName := lUserName; lResponse.DirPath := lDirPath; lResponse.Code := CNT_MESSAGE_CODE_OK; lResponse.Response := CNT_MESSAGE_TEXT_OK; lResponse.Routing.TagValue := lRequest.Routing.TagValue; // Send success response try Socket.Send( lResponse.Serialize() ); except on e: exception do WriteToLog(e.message); end; end); end); end); end else begin var lText := format("MkDir Failed, invalid path [%s] error", [lDirPath]); WriteToLog(lText); SendError(Socket, Request, lText); end; finally lParser.free; end; end; procedure TQTXTaskService.HandleFileDelete(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); begin var lRequest := TQTXFileDeleteRequest(Request); var lUserName := lRequest.UserName.trim(); var lFileName := lRequest.FileName.trim(); if lFileName.length 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; lTemp := './'; if pos(lTemp, lFileName) > 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; GetFileInfo(lRequest, lUserName, lFileName, procedure (TagValue: variant; LocalFile: string; Info: JStats; Error: Exception) begin if Error nil then begin WriteToLog(Error.message); SendError(Socket, Request, Error.Message); exit; end; if not Info.isFile then begin SendError(Socket, Request, "Filesystem object is not a file error"); exit; end; NodeJsFsAPI().unlink(LocalFile, procedure (Error: JError) begin if Error nil then begin WriteToLog(Error.message); SendError(Socket, Request, Error.message); exit; end; var lResponse := new TQTXFileDeleteResponse(lRequest.Ticket); lResponse.Routing.TagValue := request.Routing.TagValue; lResponse.UserName := lUserName; lResponse.FileName := lFileName; lResponse.Code := CNT_MESSAGE_CODE_OK; lResponse.Response := CNT_MESSAGE_TEXT_OK; try Socket.Send( lResponse.Serialize() ); except on e: exception do WriteToLog(e.message); end; end); end); end; procedure TQTXTaskService.HandleFileRename(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); begin var lRequest := TQTXFileRenameRequest(Request); var lUserName := lRequest.UserName.trim(); var lFileName := lRequest.FileName.trim(); var lNewName := lRequest.NewName.trim(); // Check filename length if lFileName.length < 1 then begin SendError(Socket, Request, Format("Invalid or empty from-filename [%s] error", [lFileName]) ); exit; end; // check newname length if lNewName.length 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; if pos(lTemp, lNewName) > 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; lTemp := './'; if pos(lTemp, lFileName) > 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; if pos(lTemp, lNewName) > 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; GetFileInfo(lRequest, lUserName, lFileName, procedure (TagValue: variant; LocalFile: string; Info: JStats; Error: Exception) begin if Error nil then begin WriteToLog(Error.message); SendError(Socket, Request, Error.Message); exit; end; if not Info.isFile then begin SendError(Socket, Request, "Filesystem object is not a file error"); exit; end; GetTranslatedPathFor(nil, lUsername, lNewName, procedure (TagValue: variant; Original, Translated: string; Error: Exception) begin if Error nil then begin WriteToLog(Error.message); SendError(Socket, Request, Error.Message); exit; end; NodeJsFsAPI().rename(LocalFile, Translated, procedure (Error: JError) begin if Error nil then begin WriteToLog(Error.message); SendError(Socket, Request, Error.message); exit; end; var lResponse := new TQTXFileRenameResponse(lRequest.Ticket); lResponse.Routing.TagValue := request.Routing.TagValue; lResponse.UserName := lUserName; lResponse.FileName := lFileName; lResponse.Code := CNT_MESSAGE_CODE_OK; lResponse.Response := CNT_MESSAGE_TEXT_OK; try Socket.Send( lResponse.Serialize() ); except on e: exception do WriteToLog(e.message); end; end); end); end); end; procedure TQTXTaskService.HandleGetDir(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); begin var lRequest := TQTXFileDirRequest(Request); var lUserName := lRequest.UserName.trim(); var lPath := lRequest.Path.trim(); // prevent path escape attempts var lTemp := "../"; if pos(lTemp, lPath) > 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; lTemp := './'; if pos(lTemp, lPath) > 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; GetTranslatedPathFor(nil, lUserName, lPath, procedure (TagValue: variant; Original, Translated: string; Error: Exception) begin if Error nil then begin WriteToLog(Error.message); SendError(Socket, Request, Error.Message); exit; end; //writeln("Translated path is:" + Translated); if not TQTXNodeFileUtils.DirectoryExists(Translated) then begin WriteToLogF("GetDir Failed, directory [%s] does not exist", [Translated]); SendError(Socket, Request, Format("GetDir failed, directory [%s] does not exist", [Original])); exit; end; var lWalker := TQTXFileWalker.Create(); lWalker.Examine(Translated, procedure (Sender: TQTXFileWalker; Error: EException) begin if Error nil then begin WriteToLogF("GetDir Failed: %s", [Error.Message]); SendError(Socket, Request, Format("GetDir failed: %s", [Error.Message])); exit; end; // Get the directory data, swap out the path // record with the original [amiga] style path var lData := Sender.ExtractList(); lData.dlPath := Original; var lResponse := new TQTXFileDirResponse(lRequest.Ticket); lResponse.Routing.TagValue := request.Routing.TagValue; lResponse.UserName := lUserName; lResponse.Path := lPath; lResponse.Assign( lData ); try Socket.Send( lResponse.Serialize() ); except on e: exception do WriteToLog(e.message); end; // release instance in 100ms TQTXDispatch.execute(procedure () begin try lWalker.free except on e: exception do begin WriteToLogF("Failed to release file-walker instance: %s", [e.message]); end; end; end, 100); end); end); end; procedure TQTXTaskService.HandleGetFileInfo(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); begin var lRequest := TQTXFileInfoRequest(Request); var lUserName := lRequest.UserName.trim(); var lFileName := lRequest.FileName.trim(); // prevent path escape attempts var lTemp := "../"; if pos(lTemp, lFileName) > 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; lTemp := './'; if pos(lTemp, lFileName) > 0 then begin SendError(Socket, Request, Format("Unsupported path sequence [%s] detected error", [lTemp]) ); exit; end; GetFileInfo(lRequest, lUserName, lFileName, procedure (TagValue: variant; LocalFile: string; Info: JStats; Error: Exception) begin if Error nil then begin WriteToLog(Error.message); SendError(Socket, Request, Error.Message); exit; end; // Collect the data var lData := new JFileItem(); lData.diFileName := lFileName; lData.diFileType := if Info.isFile then JFileItemType.wtFile else JFileItemType.wtFolder; lData.diFileSize := Info.size; lData.diFileMode := IntToStr(Info.mode); lData.diCreated := TDateUtils.FromJsDate( Info.cTime ); lData.diModified := TDateUtils.FromJsDate( Info.mTime ); var lResponse := new TQTXFileInfoResponse(lRequest.Ticket); lResponse.Routing.TagValue := request.Routing.TagValue; lResponse.UserName := lUserName; lResponse.FileName := lFileName; lResponse.Assign(lData); try Socket.Send( lResponse.Serialize() ); except on e: exception do WriteToLog(e.message); end; end); end; procedure TQTXTaskService.HandleDestroyDevice(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); begin var lMessage := TQTXFileDestroyDeviceRequest(request); // This will also destroy any files + unregister the device in the // database table for the service -- do not mess with this! UnRegisterLocalDevice(nil, lMessage.Username, lMessage.DeviceName, procedure (TagValue: variant; LocalPath: string; Error: Exception) begin if Error nil then begin WriteToLog(Error.Message); SendError(Socket, Request, Error.Message); exit; end; var lResponse := TQTXFileDestroyDeviceResponse.Create(request.ticket); lResponse.UserName := lMessage.UserName; lResponse.DeviceName := lMessage.DeviceName; lResponse.Routing.TagValue := Request.Routing.TagValue; lResponse.Code := CNT_MESSAGE_CODE_OK; lResponse.Response := CNT_MESSAGE_TEXT_OK; try Socket.Send( lResponse.Serialize() ); except on e: exception do begin WriteToLog(e.message); end; end; end); end; procedure TQTXTaskService.HandleCreateLocalDevice(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); begin var lMessage := TQTXFileCreateLocalDeviceRequest(request); // Attempt to register. // NOTE: This will automatically create a matching folder // under $cwd/userdevices/[calculated_name_of_device] RegisterLocalDevice(nil, lMessage.Username, lMessage.DeviceName, procedure (TagValue: variant; LocalPath: string; Error: Exception) begin if Error nil then begin WriteToLog(Error.Message); SendError(Socket, Request, Error.Message); exit; end; FindDeviceByName(nil, lMessage.Username, lMessage.DeviceName, procedure (TagValue: variant; Device: JDeviceInfo; Error: Exception) begin if Error nil then begin WriteToLog(Error.Message); SendError(Socket, Request, Error.Message); exit; end; var lResponse := TQTXFileCreateLocalDeviceResponse.Create(request.ticket); lResponse.UserName := lMessage.UserName; lResponse.Routing.TagValue := Request.Routing.TagValue; lResponse.Code := CNT_MESSAGE_CODE_OK; lResponse.Response := CNT_MESSAGE_TEXT_OK; if Device nil then lResponse.assign(Device); try Socket.Send( lResponse.Serialize() ); except on e: exception do begin WriteToLog(e.message); end; end; end); end); end; procedure TQTXTaskService.HandleGetDeviceByName(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); begin var lMessage := TQTXFileGetDeviceByNameRequest(request); FindDeviceByName(nil, lMessage.Username, lMessage.DeviceName, procedure (TagValue: variant; Device: JDeviceInfo; Error: Exception) begin if Error nil then begin WriteToLog(Error.Message); SendError(Socket, Request, Error.Message); exit; end; var lResponse := TQTXFileGetDeviceByNameResponse.Create(request.ticket); lResponse.UserName := lMessage.UserName; lResponse.Code := CNT_MESSAGE_CODE_OK; lResponse.Response := CNT_MESSAGE_TEXT_OK; if Device nil then lResponse.assign(Device); try Socket.Send( lResponse.Serialize() ); except on e: exception do begin WriteToLog(e.message); end; end; end); end; procedure TQTXTaskService.HandleGetDevices(Socket: TNJWebSocketSocket; Request: TQTXBaseMessage); begin var lMessage := TQTXFileGetDeviceListRequest(Request); GetDevicesForUser(nil, lMessage.Username, procedure (TagValue: variant; Devices: JDeviceList; Error: Exception) begin if Error nil then begin WriteToLog(Error.Message); SendError(Socket, Request, Error.Message); exit; end; var lResponse := TQTXFileGetDeviceListResponse.Create(request.ticket); lResponse.UserName := lMessage.UserName; lResponse.Code := CNT_MESSAGE_CODE_OK; lResponse.Response := CNT_MESSAGE_TEXT_OK; if Devices nil then lResponse.assign(Devices); try Socket.Send( lResponse.Serialize() ); except on e: exception do begin WriteToLog(e.message); end; end; end); end; procedure TQTXTaskService.AfterServerStarted; begin inherited; // Check prefs if zconfig should be applied if self.FPrefs.ReadBoolean("zconfig", "active", false) then begin // ZConfig should only run on the master instance. // We dont want to register our endpoint for each worker if NodeJSClusterAPI().isWorker then exit; writeln("Setting up Zero-Configuration layer"); FZConfig.port := FPrefs.ReadInteger('zconfig', 'bindport', 2109); FZConfig.address := GetMachineIP(); FZConfig.Start(nil, procedure (Sender: TObject; TagValue: variant; Error: Exception) begin if FPrefs.ReadBoolean("zconfig", "broadcast", true) then FZConfig.Socket.setBroadcast(true); // Build up the endpoint (URL) for our websocket server var lEndpoint := ''; if FPrefs.ReadBoolean('networking', 'secure', false) then lEndpoint := 'wss://' else lEndpoint := 'ws://'; lEndpoint += GetMachineIP(); lEndpoint += ':' + Port.ToString(); // Ping the ZConfig service on interval, until our service is registered // We keep track of the interval handle so we can stop calling on interval later FRegHandle := TQTXDispatch.SetInterval( procedure () begin inc(FRegCount); // Only output once to avoid overkill in the log if FRegCount = 1 then WriteToLogF("ZConfig registration begins [%s]", [lEndpoint]); FZConfig.RegisterService(nil, CNT_ZCONFIG_SERVICE_NAME, SERVICE_ID_TASKMANAGER, lEndpoint, procedure (TagValue: variant; Error: Exception) begin if Error = nil then begin WriteToLog("Service registered"); TQTXDispatch.ClearInterval(FRegHandle); FRegCount := 0; exit; end; end); end, 1000); end); end; end; procedure TQTXTaskService.BeforeServerStopped; begin inherited; end; procedure TQTXTaskService.Dispatch(Socket: TNJWebSocketSocket; Message: TQTXBaseMessage); begin var LInfo := MessageDispatch.GetMessageInfoForClass(Message); if LInfo nil then begin try LInfo.MessageHandler(Socket, Message); except on e: exception do begin //Log error WriteToLog(e.message); end; end; end; end; end.
“Needless to say, I’ll be porting a fair share of my libraries to C/C++ when I have time (those that makes sense under that paradigme).” – Interesting, why not use freepascal(wasm), remobjects(oxygene), or dwscript ?
It does make me question would emscripten be able to recompile fmx for web ?? (opengl->webgl, c++ -> wasm) being both are clang/llvm based ?
Looking forward to future articles.
Compiling to wasm is not really the hard part. Its a completely different underlying ecosystem. A large part of the FMX RTL would have to be re-written. WASM is completely barren, there are no standard functions or anything like that — you have to call out into the DOM context to get output etc. So its not just a matter of compiling to WASM, but having an RTL that provides the same features there.
I code in DWScript/QTX for web stuff. I have spent years making a solid system, so i have no need for FPC for example. And clang for hardcore WASM — the stdlib has been adapted for that