2 people like it.

One-Way File Synchronization

Implements one-way file synchronization, also called mirroring, between two folders.

  1: 
  2: 
  3: 
  4: 
  5: 
  6: 
  7: 
  8: 
  9: 
 10: 
 11: 
 12: 
 13: 
 14: 
 15: 
 16: 
 17: 
 18: 
 19: 
 20: 
 21: 
 22: 
 23: 
 24: 
 25: 
 26: 
 27: 
 28: 
 29: 
 30: 
 31: 
 32: 
 33: 
 34: 
 35: 
 36: 
 37: 
 38: 
 39: 
 40: 
 41: 
 42: 
 43: 
 44: 
 45: 
 46: 
 47: 
 48: 
 49: 
 50: 
 51: 
 52: 
 53: 
 54: 
 55: 
 56: 
 57: 
 58: 
 59: 
 60: 
 61: 
 62: 
 63: 
 64: 
 65: 
 66: 
 67: 
 68: 
 69: 
 70: 
 71: 
 72: 
 73: 
 74: 
 75: 
 76: 
 77: 
 78: 
 79: 
 80: 
 81: 
 82: 
 83: 
 84: 
 85: 
 86: 
 87: 
 88: 
 89: 
 90: 
 91: 
 92: 
 93: 
 94: 
 95: 
 96: 
 97: 
 98: 
 99: 
100: 
101: 
102: 
103: 
104: 
105: 
106: 
107: 
108: 
109: 
110: 
111: 
112: 
113: 
114: 
115: 
116: 
117: 
118: 
119: 
// Learn more about F# at http://fsharp.net
open Microsoft.FSharp.Control
open System.Collections.Generic
open System.Threading
open System.IO

type RequestGate(n:int) = 
    let semaphore = new Semaphore(initialCount=n,maximumCount=n);
    member x.AcquireAsync(?timeout) = 
        async {
            let! ok = Async.AwaitWaitHandle (semaphore ,?millisecondsTimeout=timeout)
            if ok then 
                return 
                    { new System.IDisposable with 
                        member x.Dispose() = semaphore.Release() |> ignore }
            else
                return! failwith "couldn't adquire a semaphore"
        }

let requestGate = RequestGate(5)

let copyStream (input:Stream) (output:Stream) = 
    let buffer = Array.zeroCreate 32768;
    let mutable flag = true
    while flag do
        let read = input.Read (buffer, 0, buffer.Length);
        if (read <= 0) then
            flag <- false;
        else
            output.Write (buffer, 0, read);
            output.Flush()

let copy (s,t) = async { 
    //limit the amount of copy operations happening simultaneously
    use! holder = requestGate.AcquireAsync()
    printf "'%s' -> '%s'\n" s t 
    use sourceStream = new FileStream(s,FileMode.Open,FileAccess.Read,FileShare.Read)
    use targetStream = new FileStream(t,FileMode.Create,FileAccess.ReadWrite,FileShare.None) 
    do! async { copyStream sourceStream targetStream }
    }

let synch (s,t) = async { 
    try
        do! copy (s,t) 
        //copy attributes
        File.SetCreationTime (t,File.GetCreationTime(s))
        File.SetLastWriteTime(t,File.GetLastWriteTime(s))
        //File.SetAccessControl(t,File.GetAccessControl(s))
        //File.SetAttributes   (t,File.GetAttributes(s))
    with ex -> printf "ERROR: copy failed with: %s\n" ex.Message
    }

let createDirectory (source,target) = async {
    if Directory.Exists target then return Some(target)
    else
        use! holder = requestGate.AcquireAsync()
        try
            Directory.CreateDirectory(target) |> ignore
            Directory.SetCreationTime (target,Directory.GetCreationTime(source))
            Directory.SetLastWriteTime(target,Directory.GetLastWriteTime(source))
            //Directory.SetAccessControl(target,Directory.GetAccessControl(source))
            return Some(target)
        with ex ->
            printf "ERROR: create directory '%s' failed with %s\n" target ex.Message
            return None
    }

let synchFolder filter mirror (source,target) = async { 
    let! target = createDirectory (source,target) 
    match target with 
    |Some(_) ->
        Directory.EnumerateFiles(source) 
        |> Seq.map(fun x -> (x,mirror x)) 
        |> Seq.filter filter 
        |> Seq.iter ( fun x ->  Async.Start (synch x) )
    |_ -> ()
    }

//filter files to copy over
let filter (s,t) =
    if File.Exists(t) then
        let source = new FileInfo(s)
        let target = new FileInfo(t)
        source.LastWriteTime > target.LastWriteTime
    else true

let folderCollector (sourceDir,targetDir)=
    
    let mirror (f:string) = 
        if f.StartsWith(sourceDir) then
            let dif = f.Substring(sourceDir.Length)
            targetDir + dif
        else failwith "Invalid argument: %s" f

    MailboxProcessor.Start( fun self ->
        let rec loop _ =
            async {
                let! (a,_) as msg = self.Receive()
                //Spawn a new task for the new folder
                printf "processing %s\n" a
                let q  =  async { 
                                  try
                                  let! folders = synchFolder filter mirror msg 
                                  for folder in Directory.EnumerateDirectories(a) do 
                                    do self.Post(folder,mirror folder) 
                                  with ex -> printf "ERROR: %s" ex.Message }
                do Async.Start q
                return! loop ()

            }
        loop ())

let synchronizeFolders (s, t) = 
    let collector = folderCollector (s,t)
    collector.Post(s,t)

synchronizeFolders (@"\\server-001\shared", @"\\server-002\shared")

System.Console.ReadLine() |> ignore
namespace Microsoft
namespace Microsoft.FSharp
namespace Microsoft.FSharp.Control
namespace System
namespace System.Collections
namespace System.Collections.Generic
namespace System.Threading
namespace System.IO
Multiple items
type RequestGate =
  new : n:int -> RequestGate
  member AcquireAsync : ?timeout:int -> Async<IDisposable>

Full name: Script.RequestGate

--------------------
new : n:int -> RequestGate
val n : int
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
val semaphore : Semaphore
Multiple items
type Semaphore =
  inherit WaitHandle
  new : initialCount:int * maximumCount:int -> Semaphore + 3 overloads
  member GetAccessControl : unit -> SemaphoreSecurity
  member Release : unit -> int + 1 overload
  member SetAccessControl : semaphoreSecurity:SemaphoreSecurity -> unit
  static member OpenExisting : name:string -> Semaphore + 1 overload

Full name: System.Threading.Semaphore

--------------------
Semaphore(initialCount: int, maximumCount: int) : unit
Semaphore(initialCount: int, maximumCount: int, name: string) : unit
Semaphore(initialCount: int, maximumCount: int, name: string, createdNew: byref<bool>) : unit
Semaphore(initialCount: int, maximumCount: int, name: string, createdNew: byref<bool>, semaphoreSecurity: System.Security.AccessControl.SemaphoreSecurity) : unit
val x : RequestGate
member RequestGate.AcquireAsync : ?timeout:int -> Async<System.IDisposable>

Full name: Script.RequestGate.AcquireAsync
val timeout : int option
val async : AsyncBuilder

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.async
val ok : bool
Multiple items
type Async
static member AsBeginEnd : computation:('Arg -> Async<'T>) -> ('Arg * AsyncCallback * obj -> IAsyncResult) * (IAsyncResult -> 'T) * (IAsyncResult -> unit)
static member AwaitEvent : event:IEvent<'Del,'T> * ?cancelAction:(unit -> unit) -> Async<'T> (requires delegate and 'Del :> Delegate)
static member AwaitIAsyncResult : iar:IAsyncResult * ?millisecondsTimeout:int -> Async<bool>
static member AwaitTask : task:Task<'T> -> Async<'T>
static member AwaitWaitHandle : waitHandle:WaitHandle * ?millisecondsTimeout:int -> Async<bool>
static member CancelDefaultToken : unit -> unit
static member Catch : computation:Async<'T> -> Async<Choice<'T,exn>>
static member FromBeginEnd : beginAction:(AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg:'Arg1 * beginAction:('Arg1 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * beginAction:('Arg1 * 'Arg2 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * arg3:'Arg3 * beginAction:('Arg1 * 'Arg2 * 'Arg3 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromContinuations : callback:(('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) -> Async<'T>
static member Ignore : computation:Async<'T> -> Async<unit>
static member OnCancel : interruption:(unit -> unit) -> Async<IDisposable>
static member Parallel : computations:seq<Async<'T>> -> Async<'T []>
static member RunSynchronously : computation:Async<'T> * ?timeout:int * ?cancellationToken:CancellationToken -> 'T
static member Sleep : millisecondsDueTime:int -> Async<unit>
static member Start : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions * ?cancellationToken:CancellationToken -> Task<'T>
static member StartChild : computation:Async<'T> * ?millisecondsTimeout:int -> Async<Async<'T>>
static member StartChildAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions -> Async<Task<'T>>
static member StartImmediate : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartWithContinuations : computation:Async<'T> * continuation:('T -> unit) * exceptionContinuation:(exn -> unit) * cancellationContinuation:(OperationCanceledException -> unit) * ?cancellationToken:CancellationToken -> unit
static member SwitchToContext : syncContext:SynchronizationContext -> Async<unit>
static member SwitchToNewThread : unit -> Async<unit>
static member SwitchToThreadPool : unit -> Async<unit>
static member TryCancelled : computation:Async<'T> * compensation:(OperationCanceledException -> unit) -> Async<'T>
static member CancellationToken : Async<CancellationToken>
static member DefaultCancellationToken : CancellationToken

Full name: Microsoft.FSharp.Control.Async

--------------------
type Async<'T>

Full name: Microsoft.FSharp.Control.Async<_>
static member Async.AwaitWaitHandle : waitHandle:WaitHandle * ?millisecondsTimeout:int -> Async<bool>
type IDisposable =
  member Dispose : unit -> unit

Full name: System.IDisposable
val x : System.IDisposable
System.IDisposable.Dispose() : unit
Semaphore.Release() : int
Semaphore.Release(releaseCount: int) : int
val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
val requestGate : RequestGate

Full name: Script.requestGate
val copyStream : input:Stream -> output:Stream -> unit

Full name: Script.copyStream
val input : Stream
type Stream =
  inherit MarshalByRefObject
  member BeginRead : buffer:byte[] * offset:int * count:int * callback:AsyncCallback * state:obj -> IAsyncResult
  member BeginWrite : buffer:byte[] * offset:int * count:int * callback:AsyncCallback * state:obj -> IAsyncResult
  member CanRead : bool
  member CanSeek : bool
  member CanTimeout : bool
  member CanWrite : bool
  member Close : unit -> unit
  member CopyTo : destination:Stream -> unit + 1 overload
  member Dispose : unit -> unit
  member EndRead : asyncResult:IAsyncResult -> int
  ...

Full name: System.IO.Stream
val output : Stream
val buffer : byte []
module Array

from Microsoft.FSharp.Collections
val zeroCreate : count:int -> 'T []

Full name: Microsoft.FSharp.Collections.Array.zeroCreate
val mutable flag : bool
val read : int
Stream.Read(buffer: byte [], offset: int, count: int) : int
property System.Array.Length: int
Stream.Write(buffer: byte [], offset: int, count: int) : unit
Stream.Flush() : unit
val copy : s:string * t:string -> Async<unit>

Full name: Script.copy
val s : string
val t : string
val holder : System.IDisposable
member RequestGate.AcquireAsync : ?timeout:int -> Async<System.IDisposable>
val printf : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printf
val sourceStream : FileStream
Multiple items
type FileStream =
  inherit Stream
  new : path:string * mode:FileMode -> FileStream + 14 overloads
  member BeginRead : array:byte[] * offset:int * numBytes:int * userCallback:AsyncCallback * stateObject:obj -> IAsyncResult
  member BeginWrite : array:byte[] * offset:int * numBytes:int * userCallback:AsyncCallback * stateObject:obj -> IAsyncResult
  member CanRead : bool
  member CanSeek : bool
  member CanWrite : bool
  member EndRead : asyncResult:IAsyncResult -> int
  member EndWrite : asyncResult:IAsyncResult -> unit
  member Flush : unit -> unit + 1 overload
  member GetAccessControl : unit -> FileSecurity
  ...

Full name: System.IO.FileStream

--------------------
FileStream(path: string, mode: FileMode) : unit
   (+0 other overloads)
FileStream(handle: Win32.SafeHandles.SafeFileHandle, access: FileAccess) : unit
   (+0 other overloads)
FileStream(path: string, mode: FileMode, access: FileAccess) : unit
   (+0 other overloads)
FileStream(handle: Win32.SafeHandles.SafeFileHandle, access: FileAccess, bufferSize: int) : unit
   (+0 other overloads)
FileStream(path: string, mode: FileMode, access: FileAccess, share: FileShare) : unit
   (+0 other overloads)
FileStream(handle: Win32.SafeHandles.SafeFileHandle, access: FileAccess, bufferSize: int, isAsync: bool) : unit
   (+0 other overloads)
FileStream(path: string, mode: FileMode, access: FileAccess, share: FileShare, bufferSize: int) : unit
   (+0 other overloads)
FileStream(path: string, mode: FileMode, access: FileAccess, share: FileShare, bufferSize: int, options: FileOptions) : unit
   (+0 other overloads)
FileStream(path: string, mode: FileMode, access: FileAccess, share: FileShare, bufferSize: int, useAsync: bool) : unit
   (+0 other overloads)
FileStream(path: string, mode: FileMode, rights: System.Security.AccessControl.FileSystemRights, share: FileShare, bufferSize: int, options: FileOptions) : unit
   (+0 other overloads)
type FileMode =
  | CreateNew = 1
  | Create = 2
  | Open = 3
  | OpenOrCreate = 4
  | Truncate = 5
  | Append = 6

Full name: System.IO.FileMode
field FileMode.Open = 3
type FileAccess =
  | Read = 1
  | Write = 2
  | ReadWrite = 3

Full name: System.IO.FileAccess
field FileAccess.Read = 1
type FileShare =
  | None = 0
  | Read = 1
  | Write = 2
  | ReadWrite = 3
  | Delete = 4
  | Inheritable = 16

Full name: System.IO.FileShare
field FileShare.Read = 1
val targetStream : FileStream
field FileMode.Create = 2
field FileAccess.ReadWrite = 3
field FileShare.None = 0
val synch : s:string * t:string -> Async<unit>

Full name: Script.synch
type File =
  static member AppendAllLines : path:string * contents:IEnumerable<string> -> unit + 1 overload
  static member AppendAllText : path:string * contents:string -> unit + 1 overload
  static member AppendText : path:string -> StreamWriter
  static member Copy : sourceFileName:string * destFileName:string -> unit + 1 overload
  static member Create : path:string -> FileStream + 3 overloads
  static member CreateText : path:string -> StreamWriter
  static member Decrypt : path:string -> unit
  static member Delete : path:string -> unit
  static member Encrypt : path:string -> unit
  static member Exists : path:string -> bool
  ...

Full name: System.IO.File
File.SetCreationTime(path: string, creationTime: System.DateTime) : unit
File.GetCreationTime(path: string) : System.DateTime
File.SetLastWriteTime(path: string, lastWriteTime: System.DateTime) : unit
File.GetLastWriteTime(path: string) : System.DateTime
val ex : exn
property System.Exception.Message: string
val createDirectory : source:string * target:string -> Async<string option>

Full name: Script.createDirectory
val source : string
val target : string
type Directory =
  static member CreateDirectory : path:string -> DirectoryInfo + 1 overload
  static member Delete : path:string -> unit + 1 overload
  static member EnumerateDirectories : path:string -> IEnumerable<string> + 2 overloads
  static member EnumerateFileSystemEntries : path:string -> IEnumerable<string> + 2 overloads
  static member EnumerateFiles : path:string -> IEnumerable<string> + 2 overloads
  static member Exists : path:string -> bool
  static member GetAccessControl : path:string -> DirectorySecurity + 1 overload
  static member GetCreationTime : path:string -> DateTime
  static member GetCreationTimeUtc : path:string -> DateTime
  static member GetCurrentDirectory : unit -> string
  ...

Full name: System.IO.Directory
Directory.Exists(path: string) : bool
union case Option.Some: Value: 'T -> Option<'T>
Directory.CreateDirectory(path: string) : DirectoryInfo
Directory.CreateDirectory(path: string, directorySecurity: System.Security.AccessControl.DirectorySecurity) : DirectoryInfo
Directory.SetCreationTime(path: string, creationTime: System.DateTime) : unit
Directory.GetCreationTime(path: string) : System.DateTime
Directory.SetLastWriteTime(path: string, lastWriteTime: System.DateTime) : unit
Directory.GetLastWriteTime(path: string) : System.DateTime
union case Option.None: Option<'T>
val synchFolder : filter:(string * string -> bool) -> mirror:(string -> string) -> source:string * target:string -> Async<unit>

Full name: Script.synchFolder
val filter : (string * string -> bool)
val mirror : (string -> string)
val target : string option
Directory.EnumerateFiles(path: string) : IEnumerable<string>
Directory.EnumerateFiles(path: string, searchPattern: string) : IEnumerable<string>
Directory.EnumerateFiles(path: string, searchPattern: string, searchOption: SearchOption) : IEnumerable<string>
module Seq

from Microsoft.FSharp.Collections
val map : mapping:('T -> 'U) -> source:seq<'T> -> seq<'U>

Full name: Microsoft.FSharp.Collections.Seq.map
val x : string
val filter : predicate:('T -> bool) -> source:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Collections.Seq.filter
val iter : action:('T -> unit) -> source:seq<'T> -> unit

Full name: Microsoft.FSharp.Collections.Seq.iter
val x : string * string
static member Async.Start : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
val filter : s:string * t:string -> bool

Full name: Script.filter
File.Exists(path: string) : bool
val source : FileInfo
Multiple items
type FileInfo =
  inherit FileSystemInfo
  new : fileName:string -> FileInfo
  member AppendText : unit -> StreamWriter
  member CopyTo : destFileName:string -> FileInfo + 1 overload
  member Create : unit -> FileStream
  member CreateText : unit -> StreamWriter
  member Decrypt : unit -> unit
  member Delete : unit -> unit
  member Directory : DirectoryInfo
  member DirectoryName : string
  member Encrypt : unit -> unit
  ...

Full name: System.IO.FileInfo

--------------------
FileInfo(fileName: string) : unit
val target : FileInfo
property FileSystemInfo.LastWriteTime: System.DateTime
val folderCollector : sourceDir:string * targetDir:string -> MailboxProcessor<string * string>

Full name: Script.folderCollector
val sourceDir : string
val targetDir : string
val f : string
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
System.String.StartsWith(value: string) : bool
System.String.StartsWith(value: string, comparisonType: System.StringComparison) : bool
System.String.StartsWith(value: string, ignoreCase: bool, culture: System.Globalization.CultureInfo) : bool
val dif : string
System.String.Substring(startIndex: int) : string
System.String.Substring(startIndex: int, length: int) : string
property System.String.Length: int
Multiple items
type MailboxProcessor<'Msg> =
  interface IDisposable
  new : body:(MailboxProcessor<'Msg> -> Async<unit>) * ?cancellationToken:CancellationToken -> MailboxProcessor<'Msg>
  member Post : message:'Msg -> unit
  member PostAndAsyncReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> Async<'Reply>
  member PostAndReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> 'Reply
  member PostAndTryAsyncReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> Async<'Reply option>
  member Receive : ?timeout:int -> Async<'Msg>
  member Scan : scanner:('Msg -> Async<'T> option) * ?timeout:int -> Async<'T>
  member Start : unit -> unit
  member TryPostAndReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> 'Reply option
  ...

Full name: Microsoft.FSharp.Control.MailboxProcessor<_>

--------------------
new : body:(MailboxProcessor<'Msg> -> Async<unit>) * ?cancellationToken:CancellationToken -> MailboxProcessor<'Msg>
static member MailboxProcessor.Start : body:(MailboxProcessor<'Msg> -> Async<unit>) * ?cancellationToken:CancellationToken -> MailboxProcessor<'Msg>
val self : MailboxProcessor<string * string>
val loop : (unit -> Async<'a>)
val a : string
val msg : string * string
member MailboxProcessor.Receive : ?timeout:int -> Async<'Msg>
val q : Async<unit>
val folders : unit
val folder : string
Directory.EnumerateDirectories(path: string) : IEnumerable<string>
Directory.EnumerateDirectories(path: string, searchPattern: string) : IEnumerable<string>
Directory.EnumerateDirectories(path: string, searchPattern: string, searchOption: SearchOption) : IEnumerable<string>
member MailboxProcessor.Post : message:'Msg -> unit
val synchronizeFolders : s:string * t:string -> unit

Full name: Script.synchronizeFolders
val collector : MailboxProcessor<string * string>
type Console =
  static member BackgroundColor : ConsoleColor with get, set
  static member Beep : unit -> unit + 1 overload
  static member BufferHeight : int with get, set
  static member BufferWidth : int with get, set
  static member CapsLock : bool
  static member Clear : unit -> unit
  static member CursorLeft : int with get, set
  static member CursorSize : int with get, set
  static member CursorTop : int with get, set
  static member CursorVisible : bool with get, set
  ...

Full name: System.Console
System.Console.ReadLine() : string

More information

Link:http://fssnip.net/3P
Posted:14 years ago
Author:Ademar Gonzalez
Tags: test