This commit is contained in:
bparodi@lezzo.org 2024-11-06 18:43:54 +01:00
parent fb3f8d6892
commit 47c378bfec
9 changed files with 113 additions and 53 deletions

1
.gitignore vendored
View file

@ -1,4 +1,5 @@
*.secret *.secret
*.jpeg
## Ignore Visual Studio temporary files, build results, and ## Ignore Visual Studio temporary files, build results, and
## files generated by popular Visual Studio add-ons. ## files generated by popular Visual Studio add-ons.

View file

@ -2,7 +2,6 @@ module Bidello.Cron
open NodaTime open NodaTime
open Cronos open Cronos
open System.Collections.Immutable
open Pentole.Path open Pentole.Path
open Pentole open Pentole
@ -12,9 +11,40 @@ open Pentole.String
open Pentole.Map open Pentole.Map
open Pentole open Pentole
type User = string
type PatternType = After of string
type WhenExpr = | Cron of Instant | Pattern of PatternType
type CronJobDefinition = {
job_name: string
user: string
when_: WhenExpr
executable: Path
args: string list
environment: (string * string) list
workdir: Path
hostname: string
}
let private convert def = {
job_name = def.job_name
hostname = def.hostname
user = def.user
executable = def.executable
args = def.args
environment = def.environment
workdir = def.workdir
}
let local_tz = DateTimeZoneProviders.Tzdb.GetSystemDefault () let local_tz = DateTimeZoneProviders.Tzdb.GetSystemDefault ()
let local_tz_net = System.TimeZoneInfo.Local let local_tz_net = System.TimeZoneInfo.Local
let private parse_expr (now: Instant) text = let private parse_expr (now: Instant) text =
@ -45,6 +75,7 @@ let private parse now (db: Requirements) =
let when_ = parse_expr now db.``when`` let when_ = parse_expr now db.``when``
let env = let env =
db.environment db.environment
|> fun s -> if isNull s then "" else s
|> String.split "|" |> String.split "|"
|> ResultList.collect (fun env_item -> |> ResultList.collect (fun env_item ->
let splitted = env_item |> String.split "=" let splitted = env_item |> String.split "="
@ -56,11 +87,6 @@ let private parse now (db: Requirements) =
let executable = Which.which db.executable let executable = Which.which db.executable
let workdir = Path.of_string db.workdir |> Result.bind FileSystem.resolve let workdir = Path.of_string db.workdir |> Result.bind FileSystem.resolve
let last_completed =
db.done_at
|> Option.map Instant.FromDateTimeUtc
|> Option.defaultValue Instant.MinValue
Result.zip when_ env Result.zip when_ env
|> Result.zip (Result.zip executable workdir) |> Result.zip (Result.zip executable workdir)
|> Result.map (fun ((executable, workdir), (when_, env)) -> |> Result.map (fun ((executable, workdir), (when_, env)) ->
@ -71,15 +97,14 @@ let private parse now (db: Requirements) =
args = db.args |> List.ofArray args = db.args |> List.ofArray
environment = List.ofSeq env environment = List.ofSeq env
workdir = workdir workdir = workdir
hostname = db.hostname hostname = db.hostname })
last_completed_at = last_completed })
type JobKey = { type JobKey = {
j: string; h: string j: string; h: string
} }
let sort_cron_jobs (now: Instant) (db_crons: Requirements seq) = let sort_jobs (now: Instant) (db_crons: Requirements seq) =
let build_deps (lst: CronJob list) = let build_deps (lst: CronJobDefinition list) =
let standalone, deps = let standalone, deps =
List.partition (function | {when_=Cron _} -> true | _ -> false) lst List.partition (function | {when_=Cron _} -> true | _ -> false) lst
@ -89,7 +114,7 @@ let sort_cron_jobs (now: Instant) (db_crons: Requirements seq) =
|> Map.ofSeq |> Map.ofSeq
in index, deps in index, deps
in in
let rec build_dependencies acc (all_jobs: Map<JobKey, CronJob>) = function let rec build_dependencies acc (all_jobs: Map<JobKey, CronJobDefinition>) = function
| [] -> Ok acc | [] -> Ok acc
| {when_=Cron _}::_ -> invalidOp "The jobs should have been partitioned" | {when_=Cron _}::_ -> invalidOp "The jobs should have been partitioned"
| {when_=Pattern (After jb)} as x::xs -> | {when_=Pattern (After jb)} as x::xs ->
@ -126,4 +151,10 @@ let sort_cron_jobs (now: Instant) (db_crons: Requirements seq) =
jobs_without_deps jobs_without_deps
|> Map.values |> Map.values
|> List.map List.singleton |> List.map List.singleton
|> List.append (Map.values jobs_with_deps |> List.map List.rev))) |> List.append (Map.values jobs_with_deps |> List.map List.rev)
|> List.map (function
| {when_=Cron instant} as hd::tail ->
let hd' = convert hd
let tail' = List.map convert tail
{scheduled_at=instant; head=hd'; rest=tail'}
| x -> invalidOp $"List is malformed? {x}")))

View file

@ -63,11 +63,9 @@ let wait_notification (ct: CancellationToken) (db: t) =
let gather_requirements (hostname: string) (ct: CancellationToken) (db: t) = let gather_requirements (hostname: string) (ct: CancellationToken) (db: t) =
let query = """select let query = """select
c.job_name, c."when", c.executable, c.user, c.workdir, c.args, h.hostname, c.job_name, c."when", c.executable, c.user, c.workdir, c.args, h.hostname,
STRING_AGG(e.variable || '=' || e.value, '|') AS environment_variables, STRING_AGG(e.variable || '=' || e.value, '|') AS environment_variables
max(b.done_at) as done_at
from cron c from cron c
left join environment e on c.job_name = e.job_name left join environment e on c.job_name = e.job_name
left join backlog b on b.job_name = c.job_name and b.hostname = @hostname
join hosts h on h.job_name = c.job_name join hosts h on h.job_name = c.job_name
where h.hostname = @hostname where h.hostname = @hostname
group by c.job_name, h.hostname """ group by c.job_name, h.hostname """

View file

@ -8,24 +8,24 @@ open Pentole.Path
[<GenerateSerializer>] [<GenerateSerializer>]
type Notification = | Time | Database type Notification = | Time | Database
[<GenerateSerializer>]
type PatternType = After of string
[<GenerateSerializer>]
type WhenExpr = | Cron of Instant | Pattern of PatternType
[<Immutable>]
[<GenerateSerializer>]
type CronJob = { type CronJob = {
job_name: string job_name: string
user: string user: string
when_: WhenExpr
executable: Path executable: Path
args: string list args: string list
environment: (string * string) list environment: (string * string) list
workdir: Path workdir: Path
hostname: string hostname: string
last_completed_at: Instant // last_completed_at: Instant
}
[<Immutable>]
[<GenerateSerializer>]
type ChainOfJobs = {
scheduled_at: Instant
head: CronJob
rest: CronJob list
} }
[<CLIMutable>] [<CLIMutable>]

View file

@ -10,13 +10,17 @@ open Bidello.Datatypes
type IShellGrain = type IShellGrain =
inherit IGrainWithIntegerKey inherit IGrainWithIntegerKey
abstract schedule: CancellationToken -> CronJob -> Task abstract schedule: CancellationToken -> ChainOfJobs -> Task
type ShellGrain() = type ShellGrain() =
inherit Orleans.Grain () inherit Orleans.Grain ()
interface IShellGrain with interface IShellGrain with
member _.schedule (ct) (job: CronJob) = task { member _.schedule (ct) (jobs: ChainOfJobs) = task {
printfn "Grain view: %A" job printfn "Grain view: --------"
printfn "HEAD= %A" jobs.head
jobs.rest |> List.iter (printfn "%A")
printfn "--------"
} }

View file

@ -1,6 +1,7 @@
module Bidello.Main module Bidello.Main
open System.Threading open System.Threading
open System.Threading.Tasks
open System open System
open NodaTime open NodaTime
@ -29,9 +30,7 @@ let logger = LoggingHelpers.from_config logger_config
(* Features: (* Features:
- per user cron jobs - per user cron jobs
- environment variables - environment variables
- output management (email, syslog) - special time specs: @weekly -> NOPE
- special time specs: @weekly
- randomized execution times
- conditional cron jobs: check something, then run - conditional cron jobs: check something, then run
- concurrency management - concurrency management
- job dependency - job dependency
@ -46,9 +45,9 @@ type Bidello(client: IClusterClient) =
let rnd = new Random (2) let rnd = new Random (2)
let db = Database.make logger let db = Database.make logger
let schedule_jobs (job: CronJob) = let schedule_jobs (jobs: ChainOfJobs) =
let runner = rnd.Next () |> client.GetGrain<IShellGrain> let runner = rnd.Next () |> client.GetGrain<IShellGrain>
runner.schedule ct job |> ignore runner.schedule ct jobs |> ignore
task { task {
while not ct.IsCancellationRequested do while not ct.IsCancellationRequested do
@ -59,15 +58,33 @@ type Bidello(client: IClusterClient) =
Database.gather_requirements hostname ct db Database.gather_requirements hostname ct db
let now = SystemClock.Instance.GetCurrentInstant () let now = SystemClock.Instance.GetCurrentInstant ()
let one_min_ago = Duration.FromMinutes 1L |> now.Minus
// let cronjobs = (* the granularity is one minute *)
// Cron.build_sorted_jobs_table logger hostname now requirements let todo_list =
Cron.sort_jobs one_min_ago requirements
|> Result.map (List.filter (fun cj -> cj.scheduled_at <= now))
// cronjobs |> Seq.iter schedule_jobs let next_job_at =
printfn "%A" requirements Cron.sort_jobs now requirements (* in the future *)
|> Result.toOption
|> Option.bind (function | [] -> None | xs -> Some xs)
|> Option.map (fun xs -> List.minBy (_.scheduled_at) xs |> _.scheduled_at)
match todo_list with
| Error e -> logger.Error $"Can't schedule cronjobs. Reason: {e}"
| Ok cronjobs ->
cronjobs
|> Seq.iter schedule_jobs
let! _wake_up = db |> Database.wait_notification ct let! _wake_up =
match next_job_at with
| None -> db |> Database.wait_notification ct
| Some time ->
let by_ = time - now |> _.TotalMilliseconds |> floor |> int32
let db_change = db |> Database.wait_notification ct
let timer = Task.Delay (by_, ct)
Task.WhenAny [timer; db_change]
() ()
} }

View file

@ -18,18 +18,23 @@ let which (executable: string) =
let shell = List.tryFind (fun sh -> sh |> Path.of_string |> Result.isOk) possible_shells let shell = List.tryFind (fun sh -> sh |> Path.of_string |> Result.isOk) possible_shells
if shell |> Option.isSome then if shell |> Option.isSome then
try let rc =
Builder Builder
.UseShell(shell.Value) .UseShell(shell.Value)
.UseExecutable("which") .UseExecutable("which")
.WithArgument(executable) .WithArgument(executable)
.UseNoThrow()
.ExecuteAsync () .ExecuteAsync ()
|> Async.AwaitTask |> Async.AwaitTask
|> Async.RunSynchronously |> Async.RunSynchronously
|> _.StandardOutput if rc.ExitCode = 0 then
rc.StandardOutput
|> _.Trim() |> _.Trim()
|> Path.of_string |> Path.of_string
|> Result.bind FileSystem.resolve elif rc.ExitCode = 1 then
with exn -> exn.Message |> Error Error $"Can't find executable path for \"{executable}\"."
else
rc.StandardError
|> Error
else else
Error "Can't find the system shell. Check your system $PATH." Error "Can't find the system shell. Check your system $PATH."

View file

@ -33,6 +33,7 @@
<PackageReference Include="FluentMigrator.Runner.Postgres" Version="6.2.0" /> <PackageReference Include="FluentMigrator.Runner.Postgres" Version="6.2.0" />
<PackageReference Include="Microsoft.Extensions.Hosting" Version="8.0.1" /> <PackageReference Include="Microsoft.Extensions.Hosting" Version="8.0.1" />
<PackageReference Include="Microsoft.Orleans.Core" Version="8.2.0" /> <PackageReference Include="Microsoft.Orleans.Core" Version="8.2.0" />
<PackageReference Include="Microsoft.Orleans.Serialization.FSharp" Version="8.2.0" />
<PackageReference Include="Microsoft.Orleans.Server" Version="8.2.0" /> <PackageReference Include="Microsoft.Orleans.Server" Version="8.2.0" />
<PackageReference Include="Microsoft.Orleans.Streaming" Version="8.2.0" /> <PackageReference Include="Microsoft.Orleans.Streaming" Version="8.2.0" />
<PackageReference Include="NodaTime" Version="3.2.0" /> <PackageReference Include="NodaTime" Version="3.2.0" />

View file

@ -16,7 +16,7 @@ let string_prefix_active_pattern () =
| _ -> Assert.Pass () | _ -> Assert.Pass ()
match "@after job " with match "@after job " with
| Prefix "@after" j -> Assert.Pass () | Prefix "@after" _ -> Assert.Pass ()
| _ -> Assert.Pass () | _ -> Assert.Pass ()
let bj = let bj =
@ -29,10 +29,13 @@ let bj =
done_at = None } done_at = None }
let run_function x = let run_function x =
let reduce (cj: CronJob) = (cj.hostname, cj.job_name) let reduce (cjs: ChainOfJobs) =
let hd = cjs.head |> fun cj -> (cj.hostname, cj.job_name)
let tail = cjs.rest |> List.map (fun cj -> (cj.hostname, cj.job_name))
hd::tail
Cron.sort_cron_jobs now x Cron.sort_jobs now x
|> Result.map (List.map (List.map reduce)) |> Result.map (List.map reduce)
|> Pentole.Result.get |> Pentole.Result.get
[<Test>] [<Test>]
@ -92,6 +95,6 @@ let should_fail_no_host () =
] ]
Cron.sort_cron_jobs now requirements Cron.sort_jobs now requirements
|> Result.isError |> Result.isError
|> Assert.is_true |> Assert.is_true