2 people like it.
Like the snippet!
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