Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
O
ocluster
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Fardale
ocluster
Commits
66a2593c
Commit
66a2593c
authored
Jun 19, 2018
by
Fardale
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
add password, send back data
parent
897a694e
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
25 additions
and
16 deletions
+25
-16
ocluster.ml
ocluster.ml
+25
-16
No files found.
ocluster.ml
View file @
66a2593c
...
...
@@ -19,8 +19,8 @@ let show_process_status fmt = function
type
answer
=
{
id
:
int
;
stdout
:
string
;
stderr
:
string
;
stdout
:
string
option
;
stderr
:
string
option
;
ret_code
:
Unix
.
process_status
;
[
@
printer
show_process_status
]
pass
:
string
;
}
...
...
@@ -34,8 +34,8 @@ let run_computation (computation:computation) =
Lwt_process
.
exec
?
timeout
:
computation
.
time
~
stdin
:
`Close
~
stdout
:
(
`FD_move
write_stdout
)
~
stderr
:
(
`FD_move
write_stderr
)
(
Lwt_process
.
shell
computation
.
script
)
>>=
fun
ret_code
->
let
%
lwt
stdout
=
Lwt_io
.
read_line
(
Lwt_io
.
of_fd
~
mode
:
Lwt_io
.
input
read_stdout
)
and
stderr
=
Lwt_io
.
read_line
(
Lwt_io
.
of_fd
~
mode
:
Lwt_io
.
input
read_stderr
)
in
let
%
lwt
stdout
=
Lwt_io
.
read_line
_opt
(
Lwt_io
.
of_fd
~
mode
:
Lwt_io
.
input
read_stdout
)
and
stderr
=
Lwt_io
.
read_line
_opt
(
Lwt_io
.
of_fd
~
mode
:
Lwt_io
.
input
read_stderr
)
in
Lwt
.
return
{
id
=
computation
.
id
;
stdout
;
stderr
;
ret_code
;
pass
=
computation
.
pass
}
let
getinetaddrbyname
name
=
...
...
@@ -45,7 +45,7 @@ let getinetaddrbyname name =
let
stat
oc
=
Lwt_io
.
write_value
oc
OK
let
server_handler
port
sockaddr
(
ic
,
oc
)
=
let
server_handler
p
ass
p
ort
sockaddr
(
ic
,
oc
)
=
let
sockaddr
=
match
sockaddr
with
|
Unix
.
ADDR_INET
(
a
,_
)
->
Unix
.
ADDR_INET
(
a
,
port
)
|
s
->
s
...
...
@@ -54,12 +54,15 @@ let server_handler port sockaddr (ic, oc) =
|
Result
.
Ok
query
->
begin
match
query
with
|
COMPUTATION
computation
->
Lwt_io
.
write_value
oc
true
<&>
Lwt_log
.
debug
(
Printf
.
sprintf
"Receive computation: %s"
(
show_computation
computation
))
>>=
fun
()
->
run_computation
computation
>>=
fun
answer
->
Lwt_io
.
with_connection
sockaddr
(
fun
(
ic
,
oc
)
->
Lwt_io
.
write_value
oc
answer
)
>>=
fun
_
->
Lwt_log
.
debug
(
Printf
.
sprintf
"End computation %i"
computation
.
id
)
if
pass
=
computation
.
pass
then
begin
Lwt_io
.
write_value
oc
true
<&>
Lwt_log
.
debug
(
Printf
.
sprintf
"Receive computation: %s"
(
show_computation
computation
))
>>=
fun
()
->
run_computation
computation
>>=
fun
answer
->
Lwt_io
.
with_connection
sockaddr
(
fun
(
ic
,
oc
)
->
Lwt_io
.
write_value
oc
answer
)
>>=
fun
()
->
Lwt_log
.
debug
(
Printf
.
sprintf
"End computation %i"
computation
.
id
)
end
else
Lwt_io
.
write_value
oc
false
<&>
Lwt_log
.
warning
"Wrong password"
|
STAT
->
stat
oc
<&>
Lwt_log
.
debug
"Receive a stat command"
end
...
...
@@ -70,14 +73,20 @@ let server_handler port sockaddr (ic, oc) =
Lwt_unix
.
sleep
2
.
;;
let
main
port
=
let
stop_server
resolver
server
_
=
Lwt
.
wakeup_later
resolver
server
let
main
pass
port
=
let
promise
,
resolver
=
Lwt
.
task
()
in
let
template
=
"$(date).$(milliseconds) $(name)[$(pid)]: $(message)"
in
Lwt_log
.
file
~
template
~
perm
:
0o600
~
file_name
:
"test.log"
()
>>=
fun
x
->
Lwt
.
return
(
Lwt_log
.
default
:=
Lwt_log
.
broadcast
[
Lwt_log
.
channel
~
template
~
close_mode
:
`Keep
~
channel
:
Lwt_io
.
stderr
()
;
x
])
>>=
fun
()
->
Lwt_io
.
establish_server_with_client_address
(
Unix
.
ADDR_INET
(
Unix
.
inet_addr_any
,
port
))
(
server_handler
port
)
>>=
fun
server
->
Lwt_unix
.
sleep
200
.
>|=
(
fun
x
->
Lwt_log
.
default
:=
Lwt_log
.
broadcast
[
Lwt_log
.
channel
~
template
~
close_mode
:
`Keep
~
channel
:
Lwt_io
.
stderr
()
;
x
])
>>=
fun
()
->
Lwt_io
.
establish_server_with_client_address
(
Unix
.
ADDR_INET
(
Unix
.
inet_addr_any
,
port
))
(
server_handler
pass
port
)
>>=
fun
server
->
let
_
=
Lwt_unix
.
on_signal
15
(
stop_server
resolver
server
)
and
_
=
Lwt_unix
.
on_signal
2
(
stop_server
resolver
server
)
and
_
=
Lwt_unix
.
on_signal
15
(
stop_server
resolver
server
)
in
promise
>>=
fun
server
->
Lwt_io
.
shutdown_server
server
<&>
Lwt_log
.
info
"Shuting down server"
let
_
=
Lwt_main
.
run
(
main
2121
)
Lwt_main
.
run
(
main
"plopissecured"
2121
)
(*Lwt_io.with_connection (Lwt_unix.ADDR_INET (Unix.inet_addr_of_string "127.0.0.1", 2121)) (fun (ic,oc) -> Lwt_io.write_value oc (COMPUTATION {id = 0; script = "#echo penis\necho plop\nls"; time = None; pass = "wesh"}));;*)
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