Minimal F# example to watch the Windows security Event Log - f#

This never prints any events to the console (after "listening for new security events..."), though when I fire up the Event Viewer app it shows security events coming in. Thoughts on what I could be doing wrong?
open System
open System.Diagnostics
open System.Security.Principal
open System.Threading
let logName = "security"
let DumpEventLog desc =
use log = new System.Diagnostics.EventLog (logName, desc)
log.EnableRaisingEvents <- true;
printfn "listening for new security events...";
log.EntryWritten.Add (fun ent ->
let ent = ent.Entry in
printfn "entry written: %d %s %s" ent.InstanceId (ent.TimeGenerated.ToString())
ent.Message);
[<EntryPoint>]
let main _argv =
let isAdministrator =
let id = WindowsIdentity.GetCurrent () in
let p = WindowsPrincipal id in
p.IsInRole WindowsBuiltInRole.Administrator
in
let () =
if not isAdministrator
then printfn "need admin privs to run!"
else DumpEventLog "."
in
while true do
Thread.Sleep 5000
done;
0

I think it has something to do with the way your program is written. For example, when DumpEventLog() exits, the log is disposed - but then the program sleeps for five seconds. I don't see how it would catch an event in that state.
This works for me:
open System.Diagnostics
open System.Threading
[<EntryPoint>]
let main _argv =
use log = new EventLog ("security", ".")
log.EnableRaisingEvents <- true
printfn "listening for new security events..."
log.EntryWritten.Add (fun e ->
printfn "Entry written: %d %O %s" e.Entry.InstanceId e.Entry.TimeGenerated e.Entry.Message)
Thread.Sleep Timeout.Infinite
0

Related

Simple example for logging text in expecto test

I'm trying to write some logs in an Expecto test, however I can't figure out how to get anything to be logged. Is there a very simple example of this somewhere? Currently I have:
module Test
open Expecto
open Expecto.Logging
open Expecto.Logging.Message
open Hopac
open Logary.Configuration
open Logary.Adapters.Facade
open Logary.Targets
[<Tests>]
let tests =
test "A simple test" {
let logger = Log.create "asdf.qwer"
let one = 1
ignore (logger.logWithAck Debug (eventX "asdf"))
Expect.equal one 1 "Should equals 1"
}
[<EntryPoint>]
let main argv =
let logary =
Config.create "MyProject.Tests" "localhost"
|> Config.targets [ LiterateConsole.create LiterateConsole.empty "console" ]
|> Config.processing (Events.events |> Events.sink ["console";])
|> Config.build
|> run
LogaryFacadeAdapter.initialise<Expecto.Logging.Logger> logary
// Invoke Expecto:
runTestsInAssemblyWithCLIArgs [] argv

F# propper remove of ElapsedEventHandler handler

Hi I have a question I have quick program that will do something in every 10 seconds and it looks simple:
[<EntryPoint>]
let main argv =
let timer = new Timer(float 10000)
let OnTimedEvent (frameId:uint32) : ElapsedEventHandler = new ElapsedEventHandler (fun obj args -> printfn "DATE: %A FRAME: %i" DateTime.Now frameId)
while(true) do
let keyStroke = Console.ReadKey()
if keyStroke.Key.Equals(ConsoleKey.Enter) then
let frameId = 1u
timer.AutoReset <- true
timer.Elapsed.RemoveHandler(OnTimedEvent frameId)
timer.Elapsed.AddHandler(OnTimedEvent frameId)
timer.Start();
else
printfn "%c pressed" keyStroke.KeyChar
0
Problem is I can not properly remove handler as it is, If i press enter once it starts and gives me one message every 10 sec so thi is what I am aiming for. But if i press enter 3 times it increments and gives me 3 messeges and so on, but i only want one.
Another thing is that if I remove parameter from it it works perfectly, so i suppose problem is with parameter. Any solutions for this?
The problem with your current implementation is that every call to OnTimedEvent returns a new instance of the ElapsedEventHandler. When you call it as follows:
timer.Elapsed.RemoveHandler(OnTimedEvent frameId)
you are removing a new handler that has not previously been registerd and so nothing actually happens. When you change your code to add/remove the same handler, then you are always using the same instance:
let frameId = 1u
let timedHandler = new ElapsedEventHandler (fun obj args ->
printfn "DATE: %A FRAME: %i" DateTime.Now frameId)
timer.Elapsed.RemoveHandler(timedHandler)
timer.Elapsed.AddHandler(timedHandler)
Now you do not have a good way of passing the frameId to your event handler. In your code, frameId is always 1u and so it's hard to see what you actually want, but you could make it mutable:
let mutable frameId = 1u
let timedHandler = new ElapsedEventHandler (fun obj args ->
printfn "DATE: %A FRAME: %i" DateTime.Now frameId)
frameId <- 2u
timer.Elapsed.RemoveHandler(timedHandler)
timer.Elapsed.AddHandler(timedHandler)
That said, it's not really clear what you are trying to do and perhaps there is an altogether different way of doing what you want.
A completely different approach would be to use MailboxProcessor that keeps the current frameId and handles two types of messages - one triggered every 10 seconds by a timer and one that can be used to change the frame ID:
type Message =
| Tick
| ChangeFrameId of uint32
let agent = MailboxProcessor.Start(fun inbox ->
let rec run frameId = async {
let! msg = inbox.Receive()
match msg with
| ChangeFrameId newId ->
return! run newId
| Tick ->
printfn "DATE: %A FRAME: %i" DateTime.Now frameId
return! run frameId }
run 1u)
let timer = new Timer(float 10000, AutoReset = true)
timer.Elapsed.Add(fun _ -> agent.Post(Tick))
timer.Start()
agent.Post(ChangeFrameId 2u)
This code refactors what you have to store the handler so that it can be removed.
open System
open System.Timers
[<EntryPoint>]
let main argv =
let timer = new Timer(float 10000, AutoReset = true)
let onTimedEvent (frameId: uint32) : ElapsedEventHandler = new ElapsedEventHandler (fun obj args -> printfn "DATE: %A FRAME: %i" DateTime.Now frameId)
let rec readKey frameId =
let handler = onTimedEvent frameId
timer.Elapsed.AddHandler(handler)
timer.Start()
let keyStroke = Console.ReadKey()
timer.Stop()
timer.Elapsed.RemoveHandler(handler)
printfn "%c pressed" keyStroke.KeyChar
let nextFrameId =
if keyStroke.Key.Equals(ConsoleKey.Enter) then
frameId + 1u
else
frameId
readKey(nextFrameId)
readKey(1u)
0
There may be better ways to accomplish what you are after, but this answers your question.

Is it a good idea to create a TcpListener from Observables?

I've been having fun playing around with the FSharp.Control.Reactive library while trying to learn some of the applications for reactive programming. Listening for a client using the .NET TcpListener class is a reactive process so I decided to create a server (in loose terms) in F# using Observables. My test use case is a single client connection from an astronomy program (Stellarium) that sends the celestial coordinates of stars in a 20 byte tcp socket stream. The code snippet I have below works but is it a good idea, or practical in anyway, to use Observables to subscribe to a TcpListener and any eventual client streams that connect? What would be the advantage or disadvantage?
open System
open System.Net
open System.Net.Sockets
open System.Threading
open System.Reactive
open System.Reactive.Linq
open System.Reactive.Concurrency
open System.Reactive.Disposables
open FSharp.Control.Reactive.Builders
open FSharp.Control.Reactive.Observable
open FSharp.Control.Reactive.Disposables
type TcpListener with
member l.AcceptClientAsync = async {
let! client = Async.AwaitTask <| l.AcceptSocketAsync()
return client
}
let readCoordinates(coords : byte[]) =
let raInt = BitConverter.ToUInt32(coords, 12)
let decInt = BitConverter.ToInt32(coords, 16)
let ra_h = float raInt * 12.0 / 2147483648.0
let dec_h = float decInt * 90.0 / 1073741824.0
if (coords.Length > 0) then
Some (ra_h, dec_h)
else
None
let listen() =
let ipAddr = IPAddress.Any
let endpoint = IPEndPoint(ipAddr, 10001)
let listener = TcpListener(endpoint)
listener.Start()
observe.While ((fun () -> true), ofAsync(listener.AcceptClientAsync))
|> bind( (fun socket -> observe.Yield(new NetworkStream(socket))) )
|> bind(fun stream -> observe.While( (fun _ -> true), ofAsync(stream.AsyncRead(20)) ))
|> map (fun bytes -> readCoordinates bytes)
[<EntryPoint>]
let main argv =
listen()
|> subscribe (fun coords -> printfn "Target Coordinates %A" coords)
|> ignore
printfn "Hit enter to continue"
Console.Read() |> ignore
0

F# program runs correctly in fsi, but hangs as an exe

I have a piece of code that adds a row to a database when a MailboxProcessor receives a message. It works correctly when run in fsi, but it hangs when compiled to an exe. The script is as follows:
#r "../packages/Newtonsoft.Json/lib/net40/Newtonsoft.Json.dll"
#r "../packages/SQLProvider/lib/FSharp.Data.SqlProvider.dll"
open Newtonsoft.Json
open FSharp.Data.Sql
open System
let [<Literal>] ResolutionPath = __SOURCE_DIRECTORY__ + "/../build/"
let [<Literal>] ConnectionString = "Data Source=" + __SOURCE_DIRECTORY__ + #"/test.db;Version=3"
// test.db is initialized as follows:
//
// BEGIN TRANSACTION;
// CREATE TABLE "Events" (
// `id`INTEGER PRIMARY KEY AUTOINCREMENT,
// `timestamp` DATETIME NOT NULL
// );
// COMMIT;
type Sql = SqlDataProvider<
ConnectionString = ConnectionString,
DatabaseVendor = Common.DatabaseProviderTypes.SQLITE,
ResolutionPath = ResolutionPath,
IndividualsAmount = 1000,
UseOptionTypes = true >
let ctx = Sql.GetDataContext()
let agent = MailboxProcessor.Start(fun (inbox:MailboxProcessor<String>) ->
let rec loop() =
async {
let! msg = inbox.Receive()
match msg with
| _ ->
let row = ctx.Main.Events.Create()
row.Timestamp <- DateTime.Now
printfn "Submitting"
ctx.SubmitUpdates()
printfn "Submitted"
return! loop()
}
loop()
)
agent.Post "Hello"
When compiled to an exe, "Submitting" is printed, but then it hangs. If you want to try it out, the full code is on github here
It seems the problem was that the main thread was exiting before the MailboxProcessor could process it's mailbox. FSI is long-lived and so this wasn't happening there. I changed:
[<EntryPoint>]
let main argv =
agent.Post "Hello"
agent.Post "Hello again"
0
to
[<EntryPoint>]
let main argv =
agent.Post "Hello"
agent.Post "Hello again"
let waitLoop = async {
while agent.CurrentQueueLength > 0 do
printfn "Sleeping"
do! Async.Sleep 1000
}
Async.RunSynchronously waitLoop
0
and now the code executes as I had intended.

How do I make this function correctly asyncronous?

I'm trying to get F# async working, and I just can't figure out what I'm doing wrong. Here's my sorta syncronous code that runs:
open System.Net
open System.Runtime.Serialization
open System.Threading.Tasks
[<DataContract>]
type Person = {
[<field: DataMember(Name = "name")>]
Name : string
[<field: DataMember(Name = "phone")>]
Phone : int
}
let url = "http://localhost:5000/app/plugins/anon/CCure"
let js = Json.DataContractJsonSerializer(typeof<Person>)
let main x =
let client = new WebClient()
let url = url + "/" + x
let reader = client.OpenRead(url)
let person = js.ReadObject(reader) :?> Person
printfn "Name: %s, Phone number: %d" person.Name person.Phone
printfn "starting x"
let x = Task.Factory.StartNew(fun () -> main "x")
printfn "starting y"
let y = Task.Factory.StartNew(fun () -> main "y")
Task.WaitAll(x, y)
I was thinking that to run it asyncronously this would work, but it doesn't:
open System.Net
open System.Runtime.Serialization
open System.Threading.Tasks
[<DataContract>]
type Person = {
[<field: DataMember(Name = "name")>]
Name : string
[<field: DataMember(Name = "phone")>]
Phone : int
}
let url = "http://localhost:5000/app/plugins/anon/CCure"
let js = Json.DataContractJsonSerializer(typeof<Person>)
let main x = async {
let client = new WebClient()
let url = url + "/" + x
let! reader = client.OpenReadAsync(url)
let person = js.ReadObject(reader) :?> Person
printfn "Name: %s, Phone number: %d" person.Name person.Phone }
printfn "starting x"
let x = Task.Factory.StartNew(fun () -> main "x")
printfn "starting y"
let y = Task.Factory.StartNew(fun () -> main "y")
Task.WaitAll(x, y)
$ fsharpc -r System.Runtime.Serialization foo.fs && ./foo.exe F#
Compiler for F# 3.1 (Open Source Edition) Freely distributed under the
Apache 2.0 Open Source License
/home/frew/code/foo.fs(19,18): error FS0001: This expression was
expected to have type
Async<'a> but here has type
unit
/home/frew/code/foo.fs(20,17): error FS0041: A unique overload for
method 'ReadObject' could not be determined based on type information
prior to this program point. A type annotation may be needed.
Candidates: XmlObjectSerializer.ReadObject(reader:
System.Xml.XmlDictionaryReader) : obj,
XmlObjectSerializer.ReadObject(reader: System.Xml.XmlReader) : obj,
XmlObjectSerializer.ReadObject(stream: System.IO.Stream) : obj
/home/frew/code/foo.fs(20,17): error FS0008: This runtime coercion or
type test from type
'a to
Person involves an indeterminate type based on information prior to this program point. Runtime type tests are not allowed on
some types. Further type annotations are needed.
What am I missing here?
OpenReadAsync is part of the .NET BCL and therefore wasn't designed with F# async in mind. You'll notice it returns unit, rather than Async<Stream>, so it won't work with let!.
The API is designed to be used with events (i.e. you have to wire up client.OpenReadCompleted).
You have a couple of options here.
There are some nice helper methods in FSharp.Core that can help
you to convert the API into a more F# friendly one (see
Async.AwaitEvent).
Use AsyncDownloadString, an extension method for WebClient that can be found in Microsoft.FSharp.Control.WebExtensions. This is easier so I've done it below although it does mean holding the whole stream in memory as a string so if you have a huge amount of Json this may not be the best idea.
It's also more idiomatic F# to use async instead of tasks for running things in parallel.
open System.Net
open System.Runtime.Serialization
open System.Threading.Tasks
open Microsoft.FSharp.Control.WebExtensions
open System.Runtime.Serialization.Json
[<DataContract>]
type Person = {
[<field: DataMember(Name = "name")>]
Name : string
[<field: DataMember(Name = "phone")>]
Phone : int
}
let url = "http://localhost:5000/app/plugins/anon/CCure"
let js = Json.DataContractJsonSerializer(typeof<Person>)
let main x = async {
printfn "Starting %s" x
let client = new WebClient()
let url = url + "/" + x
let! json = client.AsyncDownloadString(System.Uri(url))
let bytes = System.Text.Encoding.UTF8.GetBytes(json)
let st = new System.IO.MemoryStream(bytes)
let person = js.ReadObject(st) :?> Person
printfn "Name: %s, Phone number: %d" person.Name person.Phone }
let x = main "x"
let y = main "y"
[x;y] |> Async.Parallel |> Async.RunSynchronously |> ignore<unit[]>

Resources