Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
O
ocluster
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Boards
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Fardale
ocluster
Commits
0e0354d6
Commit
0e0354d6
authored
Mar 05, 2019
by
Fardale
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Correct the use of logs
parent
8305db54
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
61 additions
and
24 deletions
+61
-24
dune
dune
+2
-1
master.ml
master.ml
+12
-12
node.ml
node.ml
+9
-9
ocluster.ml
ocluster.ml
+37
-2
ocluster.opam
ocluster.opam
+1
-0
No files found.
dune
View file @
0e0354d6
...
...
@@ -15,6 +15,7 @@
(executable
(name ocluster)
(public_name ocluster)
(libraries containers containers.data atdgen lwt.unix lwt cmdliner unix logs logs.lwt)
(libraries containers containers.data atdgen lwt.unix lwt cmdliner
unix logs logs.lwt logs.fmt logs.cli fmt fmt.cli fmt.tty)
(preprocess
(pps lwt_ppx)))
master.ml
View file @
0e0354d6
...
...
@@ -42,7 +42,7 @@ let rec launch_job () =
with
|
None
->
CCDeque
.
push_front
jobs
j
;
Logs_lwt
.
debug
(
fun
m
->
m
"No free node
\n
"
)
Logs_lwt
.
debug
(
fun
m
->
m
"No free node"
)
|
Some
(
k
,
n
,
l
)
->
let
sockaddr
=
Unix
.
ADDR_INET
(
Unix
.
inet_addr_of_string
n
.
addr
,
n
.
port
)
...
...
@@ -50,7 +50,7 @@ let rec launch_job () =
SHashtbl
.
replace
nodes
k
({
n
with
cpu
=
n
.
cpu
-
j
.
cpu
;
ram
=
n
.
ram
-
j
.
ram
}
,
j
::
l
)
;
Logs_lwt
.
debug
(
fun
m
->
m
"Send computation %i,%i to %s on %i
\n
"
(
fst
j
.
id
)
(
snd
j
.
id
)
m
"Send computation %i,%i to %s on %i"
(
fst
j
.
id
)
(
snd
j
.
id
)
n
.
addr
n
.
port
)
>>=
fun
()
->
Lwt_io
.
flush
Lwt_io
.
stderr
...
...
@@ -60,7 +60,7 @@ let rec launch_job () =
)
(* TODO: check return value *)
>>=
Lwt
.
pause
>>=
launch_job
)
else
Logs_lwt
.
debug
(
fun
m
->
m
"No compuatiton
\n
"
)
else
Logs_lwt
.
debug
(
fun
m
->
m
"No compuatiton"
)
let
server_handler
pass
port
sockaddr
(
ic
,
_oc
)
=
Lwt_io
.
read
ic
...
...
@@ -71,7 +71,7 @@ let server_handler pass port sockaddr (ic, _oc) =
|
`RESULT
result
->
if
pass
=
result
.
pass
then
Logs_lwt
.
debug
(
fun
m
->
m
"Receive result: %s
\n
"
m
"Receive result: %s"
(
Serialization_j
.
string_of_result
{
result
with
stdout
=
"<stdout>"
;
stderr
=
"<stderr>"
})
)
>>=
fun
()
->
...
...
@@ -100,13 +100,13 @@ let server_handler pass port sockaddr (ic, _oc) =
else
(*Lwt_io.write oc "Wrong password"
<&>*)
Logs_lwt
.
warn
(
fun
m
->
m
"Wrong password: %s
\n
"
result
.
pass
)
Logs_lwt
.
warn
(
fun
m
->
m
"Wrong password: %s"
result
.
pass
)
|
`JOB
submission
->
if
pass
=
submission
.
pass
then
(
(*Lwt_io.write oc "true"
<&>*)
Logs_lwt
.
debug
(
fun
m
->
m
"Receive submission: %s
\n
"
m
"Receive submission: %s"
(
Serialization_j
.
string_of_submission
submission
)
)
>>=
fun
()
->
let
empty
=
CCDeque
.
is_empty
jobs
in
...
...
@@ -130,22 +130,22 @@ let server_handler pass port sockaddr (ic, _oc) =
else
(*Lwt_io.write oc "Wrong password"
<&>*)
Logs_lwt
.
warn
(
fun
m
->
m
"Wrong password: %s
\n
"
submission
.
pass
)
|
_
->
Logs_lwt
.
warn
(
fun
m
->
m
"Receive a unwanted command
\n
"
)
)
Logs_lwt
.
warn
(
fun
m
->
m
"Wrong password: %s"
submission
.
pass
)
|
_
->
Logs_lwt
.
warn
(
fun
m
->
m
"Receive a unwanted command"
)
)
|
Result
.
Error
e
->
Logs_lwt
.
err
(
fun
m
->
m
"Error during the reception of the computation: %s
\n
"
m
"Error during the reception of the computation: %s"
(
Printexc
.
to_string
e
)
)
let
stop_server
resolver
server
_
=
Lwt
.
wakeup_later
resolver
server
let
cmd
config
=
let
cmd
config
()
=
let
conf
=
Serialization_j
.
master_conf_of_string
(
CCIO
.
with_in
config
CCIO
.
read_all
)
in
List
.
iter
(
fun
n
->
SHashtbl
.
add
nodes
n
.
addr
(
n
,
[]
))
conf
.
nodes
;
let
promise
,
resolver
=
Lwt
.
task
()
in
Logs_lwt
.
app
(
fun
m
->
m
"master at %i with pass %s
\n
"
conf
.
port
conf
.
pass
)
Logs_lwt
.
info
(
fun
m
->
m
"master at %i with pass %s
"
conf
.
port
conf
.
pass
)
>>=
fun
()
->
Lwt_io
.
establish_server_with_client_address
(
Unix
.
ADDR_INET
(
Unix
.
inet_addr_any
,
conf
.
port
))
...
...
@@ -156,4 +156,4 @@ let cmd config =
promise
>>=
fun
server
->
Lwt_io
.
shutdown_server
server
<&>
Logs_lwt
.
app
(
fun
m
->
m
"Shuting down server
\n
"
)
<&>
Logs_lwt
.
info
(
fun
m
->
m
"Shuting down server
"
)
node.ml
View file @
0e0354d6
...
...
@@ -43,7 +43,7 @@ let handle_computation sockaddr computation () =
(* TODO: rendre ça résistant au crash du serveur *)
>>=
fun
()
->
Logs_lwt
.
debug
(
fun
m
->
m
"End computation %i,%i
\n
"
(
fst
computation
.
id
)
(
snd
computation
.
id
)
)
m
"End computation %i,%i"
(
fst
computation
.
id
)
(
snd
computation
.
id
)
)
let
stat
oc
=
Lwt_io
.
write_value
oc
`OK
...
...
@@ -56,29 +56,29 @@ let server_handler pass sockaddr (ic, oc) =
|
`COMPUTATION
(
computation
:
computation
)
->
if
pass
=
computation
.
pass
then
Logs_lwt
.
debug
(
fun
m
->
m
"Receive computation: %s
\n
"
m
"Receive computation: %s"
(
Serialization_j
.
string_of_computation
{
computation
with
env
=
[]
;
script
=
"<script>"
})
)
>|=
fun
()
->
Lwt
.
async
(
handle_computation
sockaddr
computation
)
else
Logs_lwt
.
warn
(
fun
m
->
m
"Wrong password: %s
\n
"
computation
.
pass
)
else
Logs_lwt
.
warn
(
fun
m
->
m
"Wrong password: %s"
computation
.
pass
)
|
`STAT
->
stat
oc
<&>
Logs_lwt
.
debug
(
fun
m
->
m
"Receive a stat command
\n
"
)
|
_
->
Logs_lwt
.
warn
(
fun
m
->
m
"Receive a unwanted command
\n
"
)
)
stat
oc
<&>
Logs_lwt
.
debug
(
fun
m
->
m
"Receive a stat command"
)
|
_
->
Logs_lwt
.
warn
(
fun
m
->
m
"Receive a unwanted command"
)
)
|
Result
.
Error
e
->
Logs_lwt
.
err
(
fun
m
->
m
"Error during the reception of the computation: %s
\n
"
m
"Error during the reception of the computation: %s"
(
Printexc
.
to_string
e
)
)
)
>>=
fun
()
->
Lwt_io
.
flush
Lwt_io
.
stderr
let
stop_server
resolver
server
_
=
Lwt
.
wakeup_later
resolver
server
let
cmd
config
=
let
cmd
config
()
=
let
conf
=
Serialization_j
.
node_conf_of_string
(
CCIO
.
with_in
config
CCIO
.
read_all
)
in
let
promise
,
resolver
=
Lwt
.
task
()
in
Logs_lwt
.
info
(
fun
m
->
m
"Node at port %i with pass %s
\n
"
conf
.
port
conf
.
pass
)
m
"Node at port %i with pass %s"
conf
.
port
conf
.
pass
)
>>=
fun
()
->
Lwt_io
.
flush
Lwt_io
.
stderr
>>=
fun
()
->
...
...
@@ -91,4 +91,4 @@ let cmd config =
promise
>>=
fun
server
->
Lwt_io
.
shutdown_server
server
<&>
Logs_lwt
.
info
(
fun
m
->
m
"Shuting down
server
\n
"
)
<&>
Logs_lwt
.
info
(
fun
m
->
m
"Shuting down
node server
"
)
ocluster.ml
View file @
0e0354d6
open
Cmdliner
let
lwt_reporter
()
=
let
buf_fmt
~
like
=
let
b
=
Buffer
.
create
512
in
(
Fmt
.
with_buffer
~
like
b
,
fun
()
->
let
m
=
Buffer
.
contents
b
in
Buffer
.
reset
b
;
m
)
in
let
app
,
app_flush
=
buf_fmt
~
like
:
Fmt
.
stdout
in
let
dst
,
dst_flush
=
buf_fmt
~
like
:
Fmt
.
stderr
in
let
reporter
=
Logs_fmt
.
reporter
~
app
~
dst
()
in
let
report
src
level
~
over
k
msgf
=
let
k
()
=
let
write
()
=
match
level
with
|
Logs
.
App
->
Lwt_io
.
write
Lwt_io
.
stdout
(
app_flush
()
)
|
_
->
Lwt_io
.
write
Lwt_io
.
stderr
(
dst_flush
()
)
in
let
unblock
()
=
over
()
;
Lwt
.
return_unit
in
Lwt
.
async
(
fun
()
->
Lwt
.
finalize
write
unblock
)
;
k
()
in
reporter
.
Logs
.
report
src
level
~
over
:
(
fun
()
->
()
)
k
msgf
in
{
Logs
.
report
}
let
setup_log
style_renderer
level
=
Fmt_tty
.
setup_std_outputs
?
style_renderer
()
;
Logs
.
set_level
level
;
Logs
.
set_reporter
(
lwt_reporter
()
)
;
()
let
setup_log
=
Term
.(
const
setup_log
$
Fmt_cli
.
style_renderer
()
$
Logs_cli
.
level
()
)
let
node_cmd
=
let
config
=
let
doc
=
"Configuration of the node"
in
...
...
@@ -13,7 +48,7 @@ let node_cmd =
"Start un computational node on the given port with the given password"
]
in
(
Term
.(
const
Lwt_main
.
run
$
(
const
Node
.
cmd
$
config
))
(
Term
.(
const
Lwt_main
.
run
$
(
const
Node
.
cmd
$
config
$
setup_log
))
,
Term
.
info
"node"
~
doc
~
sdocs
:
Manpage
.
s_common_options
~
exits
~
man
)
let
master_cmd
=
...
...
@@ -27,7 +62,7 @@ let master_cmd =
[
`S
Manpage
.
s_description
;
`P
"Start un master server on the given port with the given password"
]
in
(
Term
.(
const
Lwt_main
.
run
$
(
const
Master
.
cmd
$
config
))
(
Term
.(
const
Lwt_main
.
run
$
(
const
Master
.
cmd
$
config
$
setup_log
))
,
Term
.
info
"master"
~
doc
~
sdocs
:
Manpage
.
s_common_options
~
exits
~
man
)
let
client_cmd
=
...
...
ocluster.opam
View file @
0e0354d6
...
...
@@ -15,6 +15,7 @@ depends: [
"cmdliner"
"base-unix"
"logs"
"fmt"
]
build: [
["dune" "build" "-p" name "-j" jobs]
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment