BUG: fixing push mode and some minor tweaks

src/MechSym.SnapperReplicator/Commands/Synchronize.fs

@@ -17,8 +17,7 @@ open MechSym.SnapperReplicator.ReplicationBatch
 
 type CopySnapshotsError =
     | FailedFileTransferError of FileTransferError
-    | SyncDoneFileCreationError of CommandExecutionError
-
+
 let private copySnapshots (config: RuntimeConfiguration)
                           (batch: ReplicationBatch)
                           (executor: ExecutorService)
@@ -28,62 +27,48 @@ let private copySnapshots (config: RuntimeConfiguration)
         executor
         |> ExecutorService.getLocalExecutorOf ShellCommand.command
 
-    let sourceConfigWorkDir =
-        config
-        |> RuntimeConfiguration.getSourceConfigWorkDir
-
-    let destinationConfigWorkDir =
-        config
-        |> RuntimeConfiguration.getDestinationConfigWorkDir
-
     batch.Requests
-    |> List.map (fun request ->
-        let snapshot =
-            request |> ReplicationRequest.getSnapshot
-
-        let snapshotFileName = snapshot |> Snapshot.dumpSnapshotFileName
-
-        let sourceSnapshotFile =
-            Path.Join(sourceConfigWorkDir, snapshotFileName)
-
-        sourceSnapshotFile)
-
+    |> List.map (ReplicationRequest.getSnapshot >> Snapshot.dumpSnapshotFileName)
     |> List.append
         (batch.Requests
-         |> List.map (fun request ->
-             let snapshot =
-                 request |> ReplicationRequest.getSnapshot
-
-             let infoFileName =
-                 snapshot |> Snapshot.dumpInfoFileName
-
-             let sourceInfoFile =
-                 Path.Join(sourceConfigWorkDir, infoFileName)
-
-             sourceInfoFile))
-    |> fun (transfers: string list) ->
+         |> List.map (ReplicationRequest.getSnapshot >> Snapshot.dumpInfoFileName))
+    |> fun (fileNames: string list) ->
+        let sourceConfigWorkDir =
+            config
+            |> RuntimeConfiguration.getSourceConfigWorkDir
+
+        let destinationConfigWorkDir =
+            config
+            |> RuntimeConfiguration.getDestinationConfigWorkDir        
+
         match config.OperationMode with
-        | OperationMode.Pull -> fileTransferService.download transfers destinationConfigWorkDir
-        | OperationMode.Push -> fileTransferService.upload transfers destinationConfigWorkDir
+        | OperationMode.Pull -> fileTransferService.download sourceConfigWorkDir fileNames destinationConfigWorkDir
+        | OperationMode.Push -> fileTransferService.upload sourceConfigWorkDir fileNames destinationConfigWorkDir
     |> Result.mapError FailedFileTransferError
-    >>= (fun _ ->
-        ShellCommand.Touch(config |> RuntimeConfiguration.syncDoneFile)
-        |> executeShellOnLocal
-        |> Result.mapError SyncDoneFileCreationError
-        |> Result.ignore)
 
 type SynchronizationError =
     | CopySnapshotsError of CopySnapshotsError
     | PendingChangesError of DetermineChanges.ParsePendingChangesError
+    | SyncDoneFileCreationError of CommandExecutionError
 
 module SynchronizationError =
     let toMessage: SynchronizationError -> string = function
         | PendingChangesError err -> sprintf "Synchronization failed: %s" (err |> DetermineChanges.ParsePendingChangesError.toMessage)
         | CopySnapshotsError snapshotsError ->
             match snapshotsError with
-            | SyncDoneFileCreationError err -> sprintf "Synchronization failed. Cannot create sync.done file: %s" (err |> CommandExecutionError.toMessage)
             | FailedFileTransferError transferError ->
                 sprintf "Synchronization failed. Cannot transfer files: %s" (transferError |> FileTransferError.toMessage)
+        | SyncDoneFileCreationError err -> sprintf "Synchronization failed. Cannot create sync.done file: %s" (err |> CommandExecutionError.toMessage)
+
+let touchDoneFile (config: RuntimeConfiguration) (executor: ExecutorService) =
+    let executeShellOnLocal =
+        executor
+        |> ExecutorService.getLocalExecutorOf ShellCommand.command    
+
+    ShellCommand.Touch(config |> RuntimeConfiguration.syncDoneFile)
+    |> executeShellOnLocal
+    |> Result.mapError SyncDoneFileCreationError
+    |> Result.ignore 
 
 let execute (fileTransferService: IFileTransferService)
             (executor: ExecutorService)
@@ -97,7 +82,8 @@ let execute (fileTransferService: IFileTransferService)
     >>= (fun batch ->
         if batch.Requests |> List.isEmpty then
             printfn "There is nothing to transfer"
-            Ok()
+            Ok ()
         else
             copySnapshots config batch executor fileTransferService
             |> Result.mapError CopySnapshotsError)
+    >>= (fun _ -> touchDoneFile config executor)

src/MechSym.SnapperReplicator/Executor.fs

@@ -13,7 +13,7 @@ module Executor =
                     if output.ExitCode = 0 then
                         Ok output.Result.Output
                     else
-                        Error (LocalExecutionError (command, output.ExitCode, output.Result.Output))
+                        Error (LocalExecutionError (command, output.ExitCode, output.Result.Error))
                 let executable = commandFacade.GetExecutable command
                 let parameters = commandFacade.GetParameters command
                 let maybeStdin = commandFacade.GetStdin command

src/MechSym.SnapperReplicator/FileTransfer.fs

@@ -20,31 +20,31 @@ module FileTransferError =
 
 type IFileTransferService =
     inherit System.IDisposable
-    abstract download: sourceFiles:string list -> targetDir:string -> Result<unit, FileTransferError>
+    abstract download: sourceDir: string -> sourceFiles:string list -> targetDir:string -> Result<unit, FileTransferError>
 
-    abstract upload: sourceFiles:string list -> targetDir:string -> Result<unit, FileTransferError>
+    abstract upload: sourceDir: string -> sourceFiles:string list -> targetDir:string -> Result<unit, FileTransferError>
 
 module FileTransferService =
 
     module private SftpService =
-        let download (client: SftpClient) (sourceFiles: string list) (targetDir: string): Result<unit, FileTransferError> =
+        let download (client: SftpClient) (sourceDir: string) (sourceFileNames: string list) (targetDir: string): Result<unit, FileTransferError> =
             try
-                for sourceFile in sourceFiles do
-                    let fileName = FileInfo(sourceFile).Name
-                    printfn "Downloading: %s" fileName
-                    let targetPath = Path.Join(targetDir, fileName)
+                for sourceFileName in sourceFileNames do
+                    printfn "Downloading: %s" sourceFileName
+                    let sourceFilePath = Path.Join(sourceDir, sourceFileName)
+                    let targetPath = Path.Join(targetDir, sourceFileName)
                     use output = File.OpenWrite(targetPath)
-                    client.DownloadFile(sourceFile, output)
+                    client.DownloadFile(sourceFilePath, output)
 
                 Ok()
             with e -> Error(DownloadException e)
 
-        let upload (client: SftpClient) (sourceFiles: string list) (targetDir: string): Result<unit, FileTransferError> =
+        let upload (client: SftpClient) (sourceDir: string) (sourceFileNames: string list) (targetDir: string): Result<unit, FileTransferError> =
             try
-                for sourceFile in sourceFiles do
-                    use input = File.OpenRead(sourceFile)
-                    let sourceFileName = FileInfo(sourceFile).Name
+                for sourceFileName in sourceFileNames do
                     printfn "Uploading: %s" sourceFileName
+                    let sourceFilePath = Path.Join(sourceDir, sourceFileName)
+                    use input = File.OpenRead(sourceFilePath)
                     let targetPath = Path.Join(targetDir, sourceFileName)
                     client.UploadFile(input, targetPath)
 
@@ -53,11 +53,11 @@ module FileTransferService =
 
     let sftpService (client: SftpClient) =
         { new IFileTransferService with
-            member __.download (sourceFiles: string list) (targetDir: string): Result<unit, FileTransferError> =
-                SftpService.download client sourceFiles targetDir
+            member __.download (sourceDir: string) (sourceFiles: string list) (targetDir: string): Result<unit, FileTransferError> =
+                SftpService.download client sourceDir sourceFiles targetDir
 
-            member __.upload (sourceFiles: string list) (targetDir: string): Result<unit, FileTransferError> =
-                SftpService.upload client sourceFiles targetDir
+            member __.upload (sourceDir: string) (sourceFiles: string list) (targetDir: string): Result<unit, FileTransferError> =
+                SftpService.upload client sourceDir sourceFiles targetDir
 
             member __.Dispose() = client.Dispose() }
 
@@ -67,26 +67,26 @@ module FileTransferService =
                      (user: string)
                      (keyFile: string)
                      (localExecutor: IExecutor)
+                     (sourceDir: string)
                      (sourceFiles: string list)
                      (targetDir: string)
                      : Result<unit, FileTransferError> =
             let executeShell =
                 localExecutor.GetExecutor ShellCommand.command
 
-            ShellCommand.Rsync(mode, sourceFiles, targetDir, host, user, keyFile)
+            ShellCommand.Rsync(mode, sourceDir, sourceFiles, targetDir, host, user, keyFile)
             |> executeShell
             |> Result.mapError RsyncError
             |> Result.ignore
 
-
         let upload = download
 
     let rsyncService (mode: OperationMode) (host: string) (user: string) (keyFile: string) (localExecutor: IExecutor) =
         { new IFileTransferService with
-            member __.download (sourceFiles: string list) (targetDir: string): Result<unit, FileTransferError> =
-                RsyncFileTransferService.download mode host user keyFile localExecutor sourceFiles targetDir
+            member __.download (sourceDir: string) (sourceFiles: string list) (targetDir: string): Result<unit, FileTransferError> =
+                RsyncFileTransferService.download mode host user keyFile localExecutor sourceDir sourceFiles targetDir
 
-            member __.upload (sourceFiles: string list) (targetDir: string): Result<unit, FileTransferError> =
-                RsyncFileTransferService.upload mode host user keyFile localExecutor sourceFiles targetDir
+            member __.upload (sourceDir: string) (sourceFiles: string list) (targetDir: string): Result<unit, FileTransferError> =
+                RsyncFileTransferService.upload mode host user keyFile localExecutor sourceDir sourceFiles targetDir
 
             member __.Dispose() = () }

src/MechSym.SnapperReplicator/Main.fs

@@ -27,6 +27,8 @@ let DefaultDumpMode = DumpType.Incremental
 let DefaultTransferMode = TransferMode.Sftp
 
 let createRuntimeConfiguration (parseResult: ParseResults<CLI>): RuntimeConfiguration =
+    let operationMode = parseResult.GetResult Mode
+
     let localConfig =
         parseResult.TryGetResult Local_Config
         |> Option.defaultValue DefaultConfig
@@ -36,6 +38,13 @@ let createRuntimeConfiguration (parseResult: ParseResults<CLI>): RuntimeConfigur
         parseResult.TryGetResult Remote_Config
         |> Option.defaultValue DefaultConfig
         |> ConfigName
+
+    let sourceConfig, destinationConfig =
+        match operationMode with
+        | Pull ->
+            remoteConfig, localConfig
+        | Push ->
+            localConfig, remoteConfig
 
     let localWorkDir =
         parseResult.TryGetResult Local_Working_Directory
@@ -45,17 +54,22 @@ let createRuntimeConfiguration (parseResult: ParseResults<CLI>): RuntimeConfigur
         parseResult.TryGetResult Remote_Working_Directory
         |> Option.defaultValue DefaultWorkDir
 
+    let sourceWorkDir, destinationWorkDir =
+        match operationMode with
+        | Pull ->
+            remoteWorkDir, localWorkDir
+        | Push ->
+            localWorkDir, remoteWorkDir
+
     let batchSize =
         parseResult.TryGetResult Batch_Size
         |> Option.defaultValue DefaultBatchSize
 
-    let operationMode = parseResult.GetResult Mode
-
-    { RuntimeConfiguration.SourceConfig = remoteConfig
-      DestinationConfig = localConfig
-      DestinationWorkingDir = localWorkDir
+    { RuntimeConfiguration.SourceConfig = sourceConfig
+      DestinationConfig = destinationConfig
+      DestinationWorkDir = destinationWorkDir
       OperationMode = operationMode
-      SourceWorkingDir = remoteWorkDir
+      SourceWorkDir = sourceWorkDir
       MaximumBatchSize = batchSize }
 
 type ApplicationError =
@@ -116,7 +130,7 @@ let main argv =
 
         let runtimeConfig =
             parseResult |> createRuntimeConfiguration
-
+        
         let verbose =
             parseResult.TryGetResult Verbose |> Option.isSome
 

src/MechSym.SnapperReplicator/RuntimeConfiguration.fs

@@ -7,27 +7,27 @@ open MechSym.SnapperReplicator.Snapper
 type RuntimeConfiguration =
     { SourceConfig: ConfigName
       DestinationConfig: ConfigName
-      DestinationWorkingDir: string
-      SourceWorkingDir: string
+      DestinationWorkDir: string
+      SourceWorkDir: string
       MaximumBatchSize: int
       OperationMode: OperationMode }
 
 module RuntimeConfiguration =
     let getLocalWorkDir (this: RuntimeConfiguration) =
         match this.OperationMode with
-        | OperationMode.Pull -> this.DestinationWorkingDir
-        | OperationMode.Push -> this.SourceWorkingDir
+        | OperationMode.Pull -> this.DestinationWorkDir
+        | OperationMode.Push -> this.SourceWorkDir
 
     let getRemoteWorkDir (this: RuntimeConfiguration) =
         match this.OperationMode with
-        | OperationMode.Pull -> this.SourceWorkingDir
-        | OperationMode.Push -> this.DestinationWorkingDir
+        | OperationMode.Pull -> this.SourceWorkDir
+        | OperationMode.Push -> this.DestinationWorkDir
 
     let getDestinationConfigWorkDir (this: RuntimeConfiguration) =
-        Path.Join(this.DestinationWorkingDir, this.DestinationConfig.Value)
+        Path.Join(this.DestinationWorkDir, this.DestinationConfig.Value)
 
     let getSourceConfigWorkDir (this: RuntimeConfiguration) =
-        Path.Join(this.SourceWorkingDir, this.SourceConfig.Value)
+        Path.Join(this.SourceWorkDir, this.SourceConfig.Value)
 
     let getLocalConfigWorkDir (this: RuntimeConfiguration) =
         match this.OperationMode with

src/MechSym.SnapperReplicator/ShellCommand.fs

@@ -1,13 +1,13 @@
 namespace MechSym.SnapperReplicator.ShellCommand
 
-open System.IO
+open System
 open System.Text
 open MechSym.SnapperReplicator.Types
 
 [<RequireQualifiedAccess>]
 type ShellCommand =
     | CreateDir of path: string
-    | Rsync of mode: OperationMode * srcs: string list * dest: string * host: string * user: string * keyFile: string
+    | Rsync of mode: OperationMode * srcDir: string * srcFiles: string list * dest: string * host: string * user: string * keyFile: string
     | Touch of path: string
     | Remove of path: string
     | Tee of content: string * file: string
@@ -29,33 +29,23 @@ module ShellCommand =
     let private getParameters: ShellCommand -> string list =
         function
         | ShellCommand.CreateDir path -> [ "-p"; path ]
-        | ShellCommand.Rsync (mode, sources, dest, host, user, keyFile) ->
-            let sourceFileGroups =
-                sources
-                |> List.groupBy (fun file -> FileInfo(file).DirectoryName)
-                |> List.map (fun (dirName, files) ->
-                    dirName,
-                    files
-                    |> List.map (fun file -> FileInfo(file).Name))
-                |> List.map (fun (dirName, fileNames) -> sprintf "%s/{%s}" dirName (fileNames |> String.concat ","))
-
-            [ "-a" // archive
-              "-P" // progress
-              "-v" // verbose
-              "-e" // custom shell
+        | ShellCommand.Rsync (mode, sourceDir, _sourceFileNames, destinationDir, host, user, keyFile) ->
+            [ "-e" // custom shell
               sprintf "\"ssh -i %s\"" keyFile
 
+              "--files-from=-" //list of src files should be read from stdin
+
               match mode with
               | OperationMode.Pull ->
-                  for sourceFileGroup in sourceFileGroups do
-                      sprintf "%s@%s:%s" user host sourceFileGroup
+                  sprintf "%s@%s:%s" user host sourceDir
               | OperationMode.Push ->
-                  for sourceFileGroup in sourceFileGroups do
-                      sprintf "%s" sourceFileGroup
+                  sprintf "%s" sourceDir
 
               match mode with
-              | OperationMode.Pull -> dest
-              | OperationMode.Push -> sprintf "%s@%s:%s" user host dest ]
+              | OperationMode.Pull ->
+                  destinationDir
+              | OperationMode.Push ->
+                  sprintf "%s@%s:%s" user host destinationDir ]
 
         | ShellCommand.Touch path
         | ShellCommand.Cat path -> [ path ]
@@ -66,6 +56,11 @@ module ShellCommand =
     let private getStdin: ShellCommand -> byte [] option = function
         | ShellCommand.Tee (content, _file) ->
             content |> Encoding.UTF8.GetBytes |> Some
+        | ShellCommand.Rsync(_mode, _sourceDir, sourceFileNames, _destinationDir, _host, _user, _keyFile) ->
+            sourceFileNames
+            |> String.concat Environment.NewLine
+            |> Encoding.UTF8.GetBytes
+            |> Some
         | _ -> None
 
     let command =