evalLuv.ml 66 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447
  1. module HaxeError = Error
  2. open Luv
  3. open Globals
  4. open EvalContext
  5. open EvalExceptions
  6. open EvalValue
  7. open EvalEncode
  8. open EvalDecode
  9. open EvalHash
  10. open EvalMisc
  11. open EvalField
  12. open EvalIntegers
  13. let encode_uv_error (e:Error.t) =
  14. vint (match e with
  15. | `E2BIG -> 0
  16. | `EACCES -> 1
  17. | `EADDRINUSE -> 2
  18. | `EADDRNOTAVAIL -> 3
  19. | `EAFNOSUPPORT -> 4
  20. | `EAGAIN -> 5
  21. | `EAI_ADDRFAMILY -> 6
  22. | `EAI_AGAIN -> 7
  23. | `EAI_BADFLAGS -> 8
  24. | `EAI_BADHINTS -> 9
  25. | `EAI_CANCELED -> 10
  26. | `EAI_FAIL -> 11
  27. | `EAI_FAMILY -> 12
  28. | `EAI_MEMORY -> 13
  29. | `EAI_NODATA -> 14
  30. | `EAI_NONAME -> 15
  31. | `EAI_OVERFLOW -> 16
  32. | `EAI_PROTOCOL -> 17
  33. | `EAI_SERVICE -> 18
  34. | `EAI_SOCKTYPE -> 19
  35. | `EALREADY -> 20
  36. | `EBADF -> 21
  37. | `EBUSY -> 22
  38. | `ECANCELED -> 23
  39. (* | `ECHARSET -> 24; not defined in Luv *)
  40. | `ECONNABORTED -> 25
  41. | `ECONNREFUSED -> 26
  42. | `ECONNRESET -> 27
  43. | `EDESTADDRREQ -> 28
  44. | `EEXIST -> 29
  45. | `EFAULT -> 30
  46. | `EFBIG -> 31
  47. | `EHOSTUNREACH -> 32
  48. | `EINTR -> 33
  49. | `EINVAL -> 34
  50. | `EIO -> 35
  51. | `EISCONN -> 36
  52. | `EISDIR -> 37
  53. | `ELOOP -> 38
  54. | `EMFILE -> 39
  55. | `EMSGSIZE -> 40
  56. | `ENAMETOOLONG -> 41
  57. | `ENETDOWN -> 42
  58. | `ENETUNREACH -> 43
  59. | `ENFILE -> 44
  60. | `ENOBUFS -> 45
  61. | `ENODEV -> 46
  62. | `ENOENT -> 47
  63. | `ENOMEM -> 48
  64. | `ENONET -> 49
  65. | `ENOPROTOOPT -> 50
  66. | `ENOSPC -> 51
  67. | `ENOSYS -> 52
  68. | `ENOTCONN -> 53
  69. | `ENOTDIR -> 54
  70. | `ENOTEMPTY -> 55
  71. | `ENOTSOCK -> 56
  72. | `ENOTSUP -> 57
  73. | `EPERM -> 58
  74. | `EPIPE -> 59
  75. | `EPROTO -> 60
  76. | `EPROTONOSUPPORT -> 61
  77. | `EPROTOTYPE -> 62
  78. | `ERANGE -> 63
  79. | `EROFS -> 64
  80. | `ESHUTDOWN -> 65
  81. | `ESPIPE -> 66
  82. | `ESRCH -> 67
  83. | `ETIMEDOUT -> 68
  84. | `ETXTBSY -> 69
  85. | `EXDEV -> 70
  86. | `UNKNOWN -> 71
  87. | `EOF -> 72
  88. | `ENXIO -> 73
  89. | `EMLINK -> 74
  90. | `ENOTTY -> 75
  91. | `EFTYPE -> 76
  92. | `EILSEQ -> 77
  93. | `EOVERFLOW -> 78
  94. | `ESOCKTNOSUPPORT -> 79
  95. )
  96. let decode_uv_error v : Error.t =
  97. match decode_int v with
  98. | 0 -> `E2BIG
  99. | 1 -> `EACCES
  100. | 2 -> `EADDRINUSE
  101. | 3 -> `EADDRNOTAVAIL
  102. | 4 -> `EAFNOSUPPORT
  103. | 5 -> `EAGAIN
  104. | 6 -> `EAI_ADDRFAMILY
  105. | 7 -> `EAI_AGAIN
  106. | 8 -> `EAI_BADFLAGS
  107. | 9 -> `EAI_BADHINTS
  108. | 10 -> `EAI_CANCELED
  109. | 11 -> `EAI_FAIL
  110. | 12 -> `EAI_FAMILY
  111. | 13 -> `EAI_MEMORY
  112. | 14 -> `EAI_NODATA
  113. | 15 -> `EAI_NONAME
  114. | 16 -> `EAI_OVERFLOW
  115. | 17 -> `EAI_PROTOCOL
  116. | 18 -> `EAI_SERVICE
  117. | 19 -> `EAI_SOCKTYPE
  118. | 20 -> `EALREADY
  119. | 21 -> `EBADF
  120. | 22 -> `EBUSY
  121. | 23 -> `ECANCELED
  122. (* | 24 -> `ECHARSET not defined in Luv *)
  123. | 25 -> `ECONNABORTED
  124. | 26 -> `ECONNREFUSED
  125. | 27 -> `ECONNRESET
  126. | 28 -> `EDESTADDRREQ
  127. | 29 -> `EEXIST
  128. | 30 -> `EFAULT
  129. | 31 -> `EFBIG
  130. | 32 -> `EHOSTUNREACH
  131. | 33 -> `EINTR
  132. | 34 -> `EINVAL
  133. | 35 -> `EIO
  134. | 36 -> `EISCONN
  135. | 37 -> `EISDIR
  136. | 38 -> `ELOOP
  137. | 39 -> `EMFILE
  138. | 40 -> `EMSGSIZE
  139. | 41 -> `ENAMETOOLONG
  140. | 42 -> `ENETDOWN
  141. | 43 -> `ENETUNREACH
  142. | 44 -> `ENFILE
  143. | 45 -> `ENOBUFS
  144. | 46 -> `ENODEV
  145. | 47 -> `ENOENT
  146. | 48 -> `ENOMEM
  147. | 49 -> `ENONET
  148. | 50 -> `ENOPROTOOPT
  149. | 51 -> `ENOSPC
  150. | 52 -> `ENOSYS
  151. | 53 -> `ENOTCONN
  152. | 54 -> `ENOTDIR
  153. | 55 -> `ENOTEMPTY
  154. | 56 -> `ENOTSOCK
  155. | 57 -> `ENOTSUP
  156. | 58 -> `EPERM
  157. | 59 -> `EPIPE
  158. | 60 -> `EPROTO
  159. | 61 -> `EPROTONOSUPPORT
  160. | 62 -> `EPROTOTYPE
  161. | 63 -> `ERANGE
  162. | 64 -> `EROFS
  163. | 65 -> `ESHUTDOWN
  164. | 66 -> `ESPIPE
  165. | 67 -> `ESRCH
  166. | 68 -> `ETIMEDOUT
  167. | 69 -> `ETXTBSY
  168. | 70 -> `EXDEV
  169. | 71 -> `UNKNOWN
  170. | 72 -> `EOF
  171. | 73 -> `ENXIO
  172. | 74 -> `EMLINK
  173. | 75 -> `ENOTTY
  174. | 76 -> `EFTYPE
  175. | 77 -> `EILSEQ
  176. | 78 -> `EOVERFLOW
  177. | 79 -> `ESOCKTNOSUPPORT
  178. | _ -> unexpected_value v "eval.luv.UVError"
  179. let luv_exception e =
  180. let vi = encode_instance key_eval_luv_LuvException in
  181. match vi with
  182. | VInstance i ->
  183. let msg = EvalString.create_unknown (Error.strerror e)
  184. and error = encode_uv_error e in
  185. set_instance_field i key_exception_message msg;
  186. set_instance_field i key_native_exception error;
  187. set_instance_field i key_error error;
  188. let ctx = get_ctx() in
  189. let eval = get_eval ctx in
  190. (match eval.env with
  191. | Some _ ->
  192. let stack = EvalStackTrace.make_stack_value (call_stack eval) in
  193. set_instance_field i key_native_stack stack;
  194. | None -> ());
  195. vi
  196. | _ ->
  197. die "" __LOC__
  198. let encode_result f result =
  199. let index, args =
  200. match result with
  201. | Result.Ok r -> 0, [|f r|]
  202. | Result.Error e -> 1, [|encode_uv_error e|]
  203. in
  204. encode_enum_value key_eval_luv_Result index args None
  205. let encode_callback encode_ok_value v_callback result =
  206. let cb = prepare_callback v_callback 1 in
  207. ignore(cb [encode_result encode_ok_value result])
  208. let encode_unit () =
  209. vnull
  210. let encode_unit_result =
  211. encode_result encode_unit
  212. let encode_unit_callback =
  213. encode_callback encode_unit
  214. let resolve_result = function
  215. | Result.Ok v -> v
  216. | Result.Error e -> throw (luv_exception e) null_pos
  217. let decode_loop = function
  218. | VHandle (HLoop t) -> t
  219. | v -> unexpected_value v "eval.luv.Loop"
  220. let decode_luv_handle v : 'kind Luv.Handle.t =
  221. match decode_handle v with
  222. | HIdle t -> Handle.coerce t
  223. | HTimer t -> Handle.coerce t
  224. | HAsync t -> Handle.coerce t
  225. | HPipe t -> Handle.coerce t
  226. | HTcp t -> Handle.coerce t
  227. | HTty t -> Handle.coerce t
  228. | HUdp t -> Handle.coerce t
  229. | HSignal t -> Handle.coerce t
  230. | HProcess t -> Handle.coerce t
  231. | HFsEvent t -> Handle.coerce t
  232. | HFsPoll t -> Handle.coerce t
  233. | HPrepare t -> Handle.coerce t
  234. | HCheck t -> Handle.coerce t
  235. (* TODO
  236. | HPoll t -> Handle.coerce t
  237. *)
  238. | _ -> unexpected_value v "eval.luv.Handle"
  239. let decode_socket_handle v : [< `Stream of [< `Pipe | `TCP ] | `UDP ] Luv.Handle.t =
  240. match decode_handle v with
  241. | HTcp t -> Obj.magic t
  242. | HUdp t -> Obj.magic t
  243. | HPipe t -> Obj.magic t
  244. | _ -> unexpected_value v "eval.luv.Handle.SocketHandle"
  245. let decode_stream v : 'kind Luv.Stream.t =
  246. match decode_handle v with
  247. | HTcp t -> Stream.coerce t
  248. | HTty t -> Stream.coerce t
  249. | HPipe t -> Stream.coerce t
  250. | _ -> unexpected_value v "eval.luv.Stream"
  251. let decode_idle = function
  252. | VHandle (HIdle t) -> t
  253. | v -> unexpected_value v "eval.luv.Idle"
  254. let decode_timer = function
  255. | VHandle (HTimer t) -> t
  256. | v -> unexpected_value v "eval.luv.Timer"
  257. let decode_async = function
  258. | VHandle (HAsync t) -> t
  259. | v -> unexpected_value v "eval.luv.Async"
  260. let decode_buffer = function
  261. | VHandle (HBuffer t) -> t
  262. | v -> unexpected_value v "eval.luv.Buffer"
  263. let decode_buffers v =
  264. List.map decode_buffer (decode_array v)
  265. let encode_buffer b =
  266. VHandle (HBuffer b)
  267. let decode_sockaddr v =
  268. match decode_handle v with
  269. | HSockAddr t -> t
  270. | _ -> unexpected_value v "eval.luv.SockAddr"
  271. let encode_sockaddr h =
  272. VHandle (HSockAddr h)
  273. let decode_tcp = function
  274. | VHandle (HTcp t) -> t
  275. | v -> unexpected_value v "eval.luv.Tcp"
  276. let decode_udp = function
  277. | VHandle (HUdp t) -> t
  278. | v -> unexpected_value v "eval.luv.Udp"
  279. let encode_udp udp =
  280. VHandle (HUdp udp)
  281. let decode_udp_membership v =
  282. match decode_int v with
  283. | 0 -> `LEAVE_GROUP
  284. | 1 -> `JOIN_GROUP
  285. | _ -> unexpected_value v "eval.luv.Udp.UdpMembership"
  286. let decode_socket_type v : Sockaddr.Socket_type.t =
  287. match decode_enum v with
  288. | 0, [] -> `STREAM
  289. | 1, [] -> `DGRAM
  290. | 2, [] -> `RAW
  291. | 3, [v] -> `OTHER (decode_int v)
  292. | _ -> unexpected_value v "eval.luv.SockAddr.SocketType"
  293. let decode_address_family v : Sockaddr.Address_family.t =
  294. match decode_enum v with
  295. | 0, [] -> `UNSPEC
  296. | 1, [] -> `INET
  297. | 2, [] -> `INET6
  298. | 3, [v] -> `OTHER (decode_int v)
  299. | _ -> unexpected_value v "eval.luv.SockAddr.AddressType"
  300. let encode_address_family (a:Sockaddr.Address_family.t) =
  301. let index,args =
  302. match a with
  303. | `UNSPEC -> 0, [||]
  304. | `INET -> 1, [||]
  305. | `INET6 -> 2, [||]
  306. | `OTHER i -> 3, [|vint i|]
  307. in
  308. encode_enum_value key_eval_luv_AddressFamily index args None
  309. let encode_socket_type (a:Sockaddr.Socket_type.t) =
  310. let index,args =
  311. match a with
  312. | `STREAM -> 0, [||]
  313. | `DGRAM -> 1, [||]
  314. | `RAW -> 2, [||]
  315. | `OTHER i -> 3, [|vint i|]
  316. in
  317. encode_enum_value key_eval_luv_SocketType index args None
  318. let decode_pipe = function
  319. | VHandle (HPipe t) -> t
  320. | v -> unexpected_value v "eval.luv.Pipe"
  321. let decode_tty = function
  322. | VHandle (HTty t) -> t
  323. | v -> unexpected_value v "eval.luv.Tty"
  324. let decode_file = function
  325. | VHandle (HFile f) -> f
  326. | v -> unexpected_value v "eval.luv.File"
  327. let decode_signal = function
  328. | VHandle (HSignal t) -> t
  329. | v -> unexpected_value v "eval.luv.Signal"
  330. let decode_process = function
  331. | VHandle (HProcess t) -> t
  332. | v -> unexpected_value v "eval.luv.Process"
  333. let decode_prepare = function
  334. | VHandle (HPrepare t) -> t
  335. | v -> unexpected_value v "eval.luv.Prepare"
  336. let decode_check = function
  337. | VHandle (HCheck t) -> t
  338. | v -> unexpected_value v "eval.luv.Check"
  339. let decode_file_mode v : File.Mode.t =
  340. match decode_enum v with
  341. | 0,[] -> `IRWXU
  342. | 1,[] -> `IRUSR
  343. | 2,[] -> `IWUSR
  344. | 3,[] -> `IXUSR
  345. | 4,[] -> `IRWXG
  346. | 5,[] -> `IRGRP
  347. | 6,[] -> `IWGRP
  348. | 7,[] -> `IXGRP
  349. | 8,[] -> `IRWXO
  350. | 9,[] -> `IROTH
  351. | 10,[] -> `IWOTH
  352. | 11,[] -> `IXOTH
  353. | 12,[] -> `ISUID
  354. | 13,[] -> `ISGID
  355. | 14,[] -> `ISVTX
  356. | 15,[] -> `IFMT
  357. | 16,[] -> `IFREG
  358. | 17,[] -> `IFDIR
  359. | 18,[] -> `IFBLK
  360. | 19,[] -> `IFCHR
  361. | 20,[] -> `IFLNK
  362. | 21,[] -> `IFIFO
  363. | 22,[v2] -> `NUMERIC (decode_int v2)
  364. | _ -> unexpected_value v "eval.luv.File.FileMode"
  365. let decode_file_mode_list v =
  366. List.map decode_file_mode (decode_array v)
  367. let decode_file_request = function
  368. | VHandle (HFileRequest r) -> r
  369. | v -> unexpected_value v "eval.luv.File.FileRequest"
  370. let encode_timespec (t:File.Stat.timespec) =
  371. encode_obj [
  372. key_sec, VInt64 (Signed.Long.to_int64 t.sec);
  373. key_nsec, VInt64 (Signed.Long.to_int64 t.nsec)
  374. ]
  375. let decode_dir v =
  376. match v with
  377. | VHandle (HDir dir) -> dir
  378. | _ -> unexpected_value v "eval.luv.Dir"
  379. let encode_dirent (de:File.Dirent.t) =
  380. let kind =
  381. match de.kind with
  382. | `UNKNOWN -> 0
  383. | `FILE -> 1
  384. | `DIR -> 2
  385. | `LINK -> 3
  386. | `FIFO -> 4
  387. | `SOCKET -> 5
  388. | `CHAR -> 6
  389. | `BLOCK -> 7
  390. in
  391. encode_obj [key_kind,vint kind; key_name,vnative_string de.name]
  392. let encode_scandir sd =
  393. encode_obj [
  394. key_next,vfun0 (fun() -> encode_nullable encode_dirent (File.scandir_next sd));
  395. key_end,vfun0 (fun() -> File.scandir_end sd; vnull);
  396. ]
  397. let decode_int_flags v =
  398. if v = VNull then []
  399. else List.map decode_int (decode_array v)
  400. let decode_file_open_flag v : File.Open_flag.t =
  401. match decode_int v with
  402. | 0 -> `RDONLY
  403. | 1 -> `WRONLY
  404. | 2 -> `RDWR
  405. | 3 -> `CREAT
  406. | 4 -> `EXCL
  407. | 5 -> `EXLOCK
  408. | 6 -> `NOCTTY
  409. | 7 -> `NOFOLLOW
  410. | 8 -> `TEMPORARY
  411. | 9 -> `TRUNC
  412. | 10 -> `APPEND
  413. | 11 -> `DIRECT
  414. | 12 -> `DSYNC
  415. | 13 -> `FILEMAP
  416. | 14 -> `NOATIME
  417. | 15 -> `NONBLOCK
  418. | 16 -> `RANDOM
  419. | 17 -> `SEQUENTIAL
  420. | 18 -> `SHORT_LIVED
  421. | 19 -> `SYMLINK
  422. | 20 -> `SYNC
  423. | _ -> unexpected_value v "eval.luv.File.FileOpenFlag"
  424. let encode_file_stat (s:File.Stat.t) =
  425. encode_obj [
  426. key_dev,VUInt64 s.dev;
  427. key_mode, VHandle (HFileModeNumeric s.mode);
  428. key_nlink,VUInt64 s.nlink;
  429. key_uid,VUInt64 s.uid;
  430. key_gid,VUInt64 s.gid;
  431. key_rdev,VUInt64 s.rdev;
  432. key_ino,VUInt64 s.ino;
  433. key_size,VUInt64 s.size;
  434. key_blksize,VUInt64 s.blksize;
  435. key_blocks,VUInt64 s.blocks;
  436. key_flags,VUInt64 s.flags;
  437. key_gen,VUInt64 s.gen;
  438. key_atim,encode_timespec s.atim;
  439. key_mtim,encode_timespec s.mtim;
  440. key_ctim,encode_timespec s.ctim;
  441. key_birthtim,encode_timespec s.birthtim;
  442. ]
  443. let encode_file_statfs (s:File.Statfs.t) =
  444. encode_obj [
  445. key_type, VUInt64 s.type_;
  446. key_bsize, VUInt64 s.bsize;
  447. key_blocks, VUInt64 s.blocks;
  448. key_bfree, VUInt64 s.bfree;
  449. key_bavail, VUInt64 s.bavail;
  450. key_files, VUInt64 s.files;
  451. key_ffree, VUInt64 s.ffree;
  452. key_fspare, match s.f_spare with u1, u2, u3, u4 -> encode_array [VUInt64 u1; VUInt64 u2; VUInt64 u3; VUInt64 u4]
  453. ]
  454. let decode_fs_event = function
  455. | VHandle (HFsEvent e) -> e
  456. | v -> unexpected_value v "eval.luv.FsEvent"
  457. let decode_mutex = function
  458. | VHandle (HMutex m) -> m
  459. | v -> unexpected_value v "eval.luv.Mutex"
  460. let decode_rwlock = function
  461. | VHandle (HRwLock l) -> l
  462. | v -> unexpected_value v "eval.luv.RwLock"
  463. let decode_semaphore = function
  464. | VHandle (HSemaphore s) -> s
  465. | v -> unexpected_value v "eval.luv.Semaphore"
  466. let decode_condition = function
  467. | VHandle (HCondition c) -> c
  468. | v -> unexpected_value v "eval.luv.Condition"
  469. let decode_barrier = function
  470. | VHandle (HBarrier b) -> b
  471. | v -> unexpected_value v "eval.luv.Barrier"
  472. let decode_fs_poll = function
  473. | VHandle (HFsPoll p) -> p
  474. | v -> unexpected_value v "eval.luv.FsPoll"
  475. let uv_error_fields = [
  476. "toString", vfun1 (fun v ->
  477. let e = decode_uv_error v in
  478. EvalString.create_unknown (Error.strerror e)
  479. );
  480. "errName", vfun1 (fun v ->
  481. let e = decode_uv_error v in
  482. EvalString.create_unknown (Error.err_name e)
  483. );
  484. "translateSysError", vfun1 (fun v ->
  485. let e = decode_int v in
  486. encode_uv_error (Error.translate_sys_error e)
  487. );
  488. "setOnUnhandledException", vfun1 (fun v ->
  489. let cb = prepare_callback v 1 in
  490. Error.set_on_unhandled_exception (fun ex ->
  491. let msg =
  492. match ex with
  493. (* TODO beware of err_sub here *)
  494. | HaxeError.Error { err_message = Custom msg } ->
  495. (* Eval interpreter rethrows runtime exceptions as `Custom "Exception message\nException stack"` *)
  496. (try fst (ExtString.String.split msg "\n") with _ -> msg)
  497. | HaxeError.Error err ->
  498. let messages = ref [] in
  499. HaxeError.recurse_error (fun depth err ->
  500. let cm = make_compiler_message ~from_macro:err.err_from_macro (HaxeError.error_msg err.err_message) err.err_pos depth DKCompilerMessage Error in
  501. match MessageReporting.compiler_message_string cm with
  502. | None -> ()
  503. | Some str -> messages := str :: !messages
  504. ) err;
  505. ExtLib.String.join "\n" (List.rev !messages)
  506. | _ -> Printexc.to_string ex
  507. in
  508. let e = create_haxe_exception ~stack:(get_ctx()).exception_stack msg in
  509. ignore(cb [e])
  510. );
  511. vnull
  512. );
  513. ]
  514. let loop_fields = [
  515. "run", vfun2 (fun v1 v2 ->
  516. let loop = decode_loop v1
  517. and mode =
  518. match decode_int v2 with
  519. | 0 -> `DEFAULT
  520. | 1 -> `ONCE
  521. | 2 -> `NOWAIT
  522. | _ -> unexpected_value v2 "valid loop run mode"
  523. in
  524. vbool (Loop.run ~loop ~mode ())
  525. );
  526. "stop", vfun1 (fun v ->
  527. let loop = decode_loop v in
  528. Loop.stop loop;
  529. vnull
  530. );
  531. "init", vfun0 (fun () ->
  532. encode_result (fun l -> VHandle (HLoop l)) (Loop.init())
  533. );
  534. "close", vfun1 (fun v ->
  535. let loop = decode_loop v in
  536. encode_unit_result (Loop.close loop)
  537. );
  538. "alive", vfun1 (fun v ->
  539. let loop = decode_loop v in
  540. vbool (Loop.alive loop)
  541. );
  542. "defaultLoop", vfun0 (fun () ->
  543. VHandle (HLoop (Loop.default()))
  544. );
  545. "libraryShutdown", vfun0 (fun () ->
  546. Loop.library_shutdown();
  547. vnull
  548. );
  549. "now", vfun1 (fun v ->
  550. let loop = decode_loop v in
  551. VUInt64 (Loop.now loop)
  552. );
  553. "updateTime", vfun1 (fun v ->
  554. let loop = decode_loop v in
  555. Loop.update_time loop;
  556. vnull
  557. );
  558. ]
  559. let handle_fields = [
  560. "close", vfun2 (fun v1 v2 ->
  561. let handle = decode_luv_handle v1
  562. and cb = prepare_callback v2 0 in
  563. Handle.close handle (fun() -> ignore(cb []));
  564. vnull
  565. );
  566. "isActive", vfun1 (fun v ->
  567. let handle = decode_luv_handle v in
  568. vbool (Handle.is_active handle)
  569. );
  570. "isClosing", vfun1 (fun v ->
  571. let handle = decode_luv_handle v in
  572. vbool (Handle.is_closing handle)
  573. );
  574. "ref", vfun1 (fun v ->
  575. let handle = decode_luv_handle v in
  576. Handle.ref handle;
  577. vnull
  578. );
  579. "unref", vfun1 (fun v ->
  580. let handle = decode_luv_handle v in
  581. Handle.unref handle;
  582. vnull
  583. );
  584. "hasRef", vfun1 (fun v ->
  585. let handle = decode_luv_handle v in
  586. vbool (Handle.has_ref handle)
  587. );
  588. "sendBufferSize", vfun1 (fun v ->
  589. let handle = decode_socket_handle v in
  590. encode_result vint (Handle.send_buffer_size handle)
  591. );
  592. "setSendBufferSize", vfun2 (fun v1 v2 ->
  593. let handle = decode_socket_handle v1
  594. and size = decode_int v2 in
  595. encode_unit_result (Handle.set_send_buffer_size handle size)
  596. );
  597. "recvBufferSize", vfun1 (fun v ->
  598. let handle = decode_socket_handle v in
  599. encode_result vint (Handle.recv_buffer_size handle)
  600. );
  601. "setRendBufferSize", vfun2 (fun v1 v2 ->
  602. let handle = decode_socket_handle v1
  603. and size = decode_int v2 in
  604. encode_unit_result (Handle.set_recv_buffer_size handle size)
  605. );
  606. ]
  607. let idle_fields = [
  608. "init", vfun1 (fun v ->
  609. let loop = decode_loop v in
  610. encode_result (fun i -> VHandle (HIdle i)) (Idle.init ~loop ())
  611. );
  612. "start", vfun2 (fun v1 v2 ->
  613. let idle = decode_idle v1 in
  614. let cb = prepare_callback v2 0 in
  615. encode_unit_result (Idle.start idle (fun() -> ignore(cb [])));
  616. );
  617. "stop", vfun1 (fun v ->
  618. let idle = decode_idle v in
  619. encode_unit_result (Idle.stop idle)
  620. );
  621. ]
  622. let timer_fields = [
  623. "init", vfun1 (fun v ->
  624. let loop = decode_loop v in
  625. encode_result (fun i -> VHandle (HTimer i)) (Timer.init ~loop ())
  626. );
  627. "start", vfun4 (fun v1 v2 v3 v4 ->
  628. let timer = decode_timer v1
  629. and cb = prepare_callback v2 0
  630. and timeout = decode_int v3
  631. and repeat = default_int v4 0 in
  632. encode_unit_result (Timer.start ~repeat timer timeout (fun() -> ignore(cb [])));
  633. );
  634. "stop", vfun1 (fun v ->
  635. let timer = decode_timer v in
  636. encode_unit_result (Timer.stop timer)
  637. );
  638. "again", vfun1 (fun v ->
  639. let timer = decode_timer v in
  640. encode_unit_result (Timer.again timer)
  641. );
  642. "set_repeat", vfun2 (fun v1 v2 ->
  643. let timer = decode_timer v1
  644. and repeat = decode_int v2 in
  645. Timer.set_repeat timer repeat;
  646. vint repeat
  647. );
  648. "get_repeat", vfun1 (fun v1 ->
  649. let timer = decode_timer v1 in
  650. vint (Timer.get_repeat timer)
  651. );
  652. "get_dueIn", vfun1 (fun v1 ->
  653. let timer = decode_timer v1 in
  654. vint (Timer.get_due_in timer)
  655. );
  656. ]
  657. let async_fields = [
  658. "init", vfun2 (fun v1 v2 ->
  659. let loop = decode_loop v1
  660. and cb = prepare_callback v2 1 in
  661. let callback async = ignore(cb [VHandle (HAsync async)]) in
  662. encode_result (fun i -> VHandle (HAsync i)) (Async.init ~loop callback)
  663. );
  664. "send", vfun1 (fun v ->
  665. let async = decode_async v in
  666. encode_unit_result (Async.send async);
  667. );
  668. ]
  669. let buffer_get getter = vfun2 (fun v1 v2 ->
  670. let buffer = decode_buffer v1
  671. and index = decode_int v2 in
  672. vint (int_of_char (getter buffer index))
  673. )
  674. let buffer_set setter = vfun3 (fun v1 v2 v3 ->
  675. let buffer = decode_buffer v1
  676. and index = decode_int v2
  677. and byte = decode_int v3 in
  678. setter buffer index (char_of_int byte);
  679. v3
  680. )
  681. let buffer_fields = [
  682. "create", vfun1 (fun v ->
  683. let size = decode_int v in
  684. encode_buffer (Buffer.create size)
  685. );
  686. "fromNativeString", vfun1 (fun v ->
  687. let s = decode_native_string v in
  688. encode_buffer (Buffer.from_string s)
  689. );
  690. "fromString", vfun1 (fun v ->
  691. let s = decode_string v in
  692. encode_buffer (Buffer.from_string s)
  693. );
  694. "fromBytes", vfun1 (fun v ->
  695. let b = decode_bytes v in
  696. encode_buffer (Buffer.from_bytes b)
  697. );
  698. "totalSize", vfun1 (fun v ->
  699. let l = decode_buffers v in
  700. vint (Buffer.total_size l)
  701. );
  702. "drop", vfun2 (fun v1 v2 ->
  703. let l = decode_buffers v1
  704. and count = decode_int v2
  705. and encode_buffer buffer = encode_buffer buffer in
  706. encode_array (List.map encode_buffer (Buffer.drop l count))
  707. );
  708. "size", vfun1 (fun v ->
  709. let buffer = decode_buffer v in
  710. vint (Buffer.size buffer)
  711. );
  712. "get", buffer_get Buffer.get;
  713. "unsafeGet", buffer_get Buffer.unsafe_get;
  714. "set", buffer_set Buffer.set;
  715. "unsafeSet", buffer_set Buffer.unsafe_set;
  716. "sub", vfun3 (fun v1 v2 v3 ->
  717. let buffer = decode_buffer v1
  718. and offset = decode_int v2
  719. and length = decode_int v3 in
  720. encode_buffer (Buffer.sub buffer offset length)
  721. );
  722. "blit", vfun2 (fun v1 v2 ->
  723. let buffer = decode_buffer v1
  724. and destination = decode_buffer v2 in
  725. Buffer.blit buffer destination;
  726. vnull
  727. );
  728. "fill", vfun2 (fun v1 v2 ->
  729. let buffer = decode_buffer v1
  730. and byte = decode_int v2 in
  731. Buffer.fill buffer (char_of_int byte);
  732. vnull
  733. );
  734. "toString", vfun1 (fun v ->
  735. let buffer = decode_buffer v in
  736. EvalString.create_unknown (Buffer.to_string buffer)
  737. );
  738. "toNativeString", vfun1 (fun v ->
  739. let buffer = decode_buffer v in
  740. vnative_string (Buffer.to_string buffer)
  741. );
  742. "toBytes", vfun1 (fun v ->
  743. let buffer = decode_buffer v in
  744. encode_bytes (Buffer.to_bytes buffer)
  745. );
  746. "blitToBytes", vfun3 (fun v1 v2 v3 ->
  747. let buffer = decode_buffer v1
  748. and destination = decode_bytes v2
  749. and offset = decode_int v3 in
  750. Buffer.blit_to_bytes buffer destination offset;
  751. vnull
  752. );
  753. "blitFromBytes", vfun3 (fun v1 v2 v3 ->
  754. let buffer = decode_buffer v1
  755. and source = decode_bytes v2
  756. and offset = decode_int v3 in
  757. Buffer.blit_from_bytes buffer source offset;
  758. vnull
  759. );
  760. "blitFromString", vfun3 (fun v1 v2 v3 ->
  761. let buffer = decode_buffer v1
  762. and source = decode_native_string v2
  763. and offset = decode_int v3 in
  764. Buffer.blit_from_string buffer source offset;
  765. vnull
  766. );
  767. ]
  768. let sockaddr_fields = [
  769. "get_port", vfun1 (fun v ->
  770. let a = decode_sockaddr v in
  771. encode_nullable vint (Sockaddr.port a)
  772. );
  773. "ipv4", vfun2 (fun v1 v2 ->
  774. let host = decode_string v1
  775. and port = decode_int v2 in
  776. encode_result encode_sockaddr (Sockaddr.ipv4 host port)
  777. );
  778. "ipv6", vfun2 (fun v1 v2 ->
  779. let host = decode_string v1
  780. and port = decode_int v2 in
  781. encode_result encode_sockaddr (Sockaddr.ipv6 host port)
  782. );
  783. "toString", vfun1 (fun v ->
  784. let a = decode_sockaddr v in
  785. match Sockaddr.to_string a with
  786. | Some s -> EvalString.create_unknown s
  787. | None -> EvalString.vstring (EvalString.create_ascii "")
  788. );
  789. ]
  790. let tcp_fields = [
  791. "init", vfun2 (fun v1 v2 ->
  792. let loop = decode_loop v1
  793. and domain = decode_optional decode_address_family v2 in
  794. let tcp = TCP.init ~loop ?domain () in
  795. encode_result (fun t -> VHandle (HTcp t)) tcp
  796. );
  797. "noDelay", vfun2 (fun v1 v2 ->
  798. let tcp = decode_tcp v1
  799. and value = decode_bool v2 in
  800. encode_unit_result (TCP.nodelay tcp value)
  801. );
  802. "keepAlive", vfun2 (fun v1 v2 ->
  803. let tcp = decode_tcp v1
  804. and value = decode_option decode_int v2 in
  805. encode_unit_result (TCP.keepalive tcp value)
  806. );
  807. "simultaneousAccepts", vfun2 (fun v1 v2 ->
  808. let tcp = decode_tcp v1
  809. and value = decode_bool v2 in
  810. encode_unit_result (TCP.simultaneous_accepts tcp value)
  811. );
  812. "bind", vfun3 (fun v1 v2 v3 ->
  813. let tcp = decode_tcp v1
  814. and addr = decode_sockaddr v2
  815. and ipv6only = decode_optional decode_bool v3 in
  816. encode_unit_result (TCP.bind ?ipv6only tcp addr)
  817. );
  818. "getSockName", vfun1 (fun v ->
  819. let tcp = decode_tcp v in
  820. encode_result encode_sockaddr (TCP.getsockname tcp)
  821. );
  822. "getPeerName", vfun1 (fun v ->
  823. let tcp = decode_tcp v in
  824. encode_result encode_sockaddr (TCP.getpeername tcp)
  825. );
  826. "connect", vfun3 (fun v1 v2 v3 ->
  827. let tcp = decode_tcp v1
  828. and addr = decode_sockaddr v2 in
  829. TCP.connect tcp addr (encode_unit_callback v3);
  830. vnull
  831. );
  832. "closeReset", vfun2 (fun v1 v2 ->
  833. let tcp = decode_tcp v1 in
  834. TCP.close_reset tcp (encode_unit_callback v2);
  835. vnull
  836. );
  837. ]
  838. let udp_fields = [
  839. "init", vfun3 (fun v1 v2 v3 ->
  840. let loop = decode_loop v1
  841. and domain = decode_optional decode_address_family v2
  842. and recvmmsg = decode_optional decode_bool v3 in
  843. let udp = UDP.init ~loop ?domain ?recvmmsg () in
  844. encode_result encode_udp udp
  845. );
  846. "bind", vfun4 (fun v1 v2 v3 v4 ->
  847. let udp = decode_udp v1
  848. and addr = decode_sockaddr v2
  849. and ipv6only = decode_optional decode_bool v3
  850. and reuseaddr = decode_optional decode_bool v4 in
  851. encode_unit_result (UDP.bind ?ipv6only ?reuseaddr udp addr)
  852. );
  853. "connect", vfun2 (fun v1 v2 ->
  854. let udp = decode_udp v1
  855. and addr = decode_sockaddr v2 in
  856. match UDP.Connected.connect udp addr with
  857. | Ok () -> encode_result encode_udp (Ok udp)
  858. | Error e -> encode_result encode_udp (Error e)
  859. );
  860. "getSockName", vfun1 (fun v ->
  861. let udp = decode_udp v in
  862. encode_result encode_sockaddr (UDP.getsockname udp)
  863. );
  864. "setMembership", vfun4 (fun v1 v2 v3 v4 ->
  865. let udp = decode_udp v1
  866. and group = decode_string v2
  867. and interface = decode_string v3
  868. and membership = decode_udp_membership v4 in
  869. encode_unit_result (UDP.set_membership udp ~group ~interface membership)
  870. );
  871. "setSourceMembership", vfun5 (fun v1 v2 v3 v4 v5 ->
  872. let udp = decode_udp v1
  873. and group = decode_string v2
  874. and interface = decode_string v3
  875. and source = decode_string v4
  876. and membership = decode_udp_membership v5 in
  877. encode_unit_result (UDP.set_source_membership udp ~group ~interface ~source membership)
  878. );
  879. "setMulticastLoop", vfun2 (fun v1 v2 ->
  880. let udp = decode_udp v1
  881. and value = decode_bool v2 in
  882. encode_unit_result (UDP.set_multicast_loop udp value)
  883. );
  884. "setMulticastTtl", vfun2 (fun v1 v2 ->
  885. let udp = decode_udp v1
  886. and value = decode_int v2 in
  887. encode_unit_result (UDP.set_multicast_ttl udp value)
  888. );
  889. "setMulticastInterface", vfun2 (fun v1 v2 ->
  890. let udp = decode_udp v1
  891. and value = decode_string v2 in
  892. encode_unit_result (UDP.set_multicast_interface udp value)
  893. );
  894. "setBroadcast", vfun2 (fun v1 v2 ->
  895. let udp = decode_udp v1
  896. and value = decode_bool v2 in
  897. encode_unit_result (UDP.set_broadcast udp value)
  898. );
  899. "setTtl", vfun2 (fun v1 v2 ->
  900. let udp = decode_udp v1
  901. and value = decode_int v2 in
  902. encode_unit_result (UDP.set_ttl udp value)
  903. );
  904. "send", vfun4 (fun v1 v2 v3 v4 ->
  905. let udp = decode_udp v1
  906. and l = decode_buffers v2
  907. and addr = decode_sockaddr v3 in
  908. UDP.send udp l addr (encode_unit_callback v4);
  909. vnull
  910. );
  911. "trySend", vfun3 (fun v1 v2 v3 ->
  912. let udp = decode_udp v1
  913. and l = decode_buffers v2
  914. and addr = decode_sockaddr v3 in
  915. encode_unit_result (UDP.try_send udp l addr)
  916. );
  917. "recvStart", vfun3 (fun v1 v2 v3 ->
  918. let encode (buf,addr,flags) =
  919. let encode_flag = function
  920. | `PARTIAL -> vint 0
  921. | `MMSG_CHUNK -> vint 1
  922. | `MMSG_FREE -> vint 2
  923. in
  924. encode_obj [
  925. key_data,encode_buffer buf;
  926. key_addr,encode_option encode_sockaddr addr;
  927. key_flags,encode_array (List.map encode_flag flags)
  928. ]
  929. in
  930. let udp = decode_udp v1
  931. and callback = encode_callback encode v2
  932. and allocate =
  933. decode_optional (fun v ->
  934. let cb = prepare_callback v 1 in
  935. (fun i -> decode_buffer (cb [vint i]))
  936. ) v3
  937. in
  938. UDP.recv_start ?allocate udp callback;
  939. vnull
  940. );
  941. "recvStop", vfun1 (fun v ->
  942. let udp = decode_udp v in
  943. encode_unit_result (UDP.recv_stop udp)
  944. );
  945. "getSendQueueSize", vfun1 (fun v ->
  946. let udp = decode_udp v in
  947. vint (UDP.get_send_queue_size udp)
  948. );
  949. "getSendQueueCount", vfun1 (fun v ->
  950. let udp = decode_udp v in
  951. vint (UDP.get_send_queue_count udp)
  952. );
  953. ]
  954. let connected_udp_fields = [
  955. "disconnect", vfun1 (fun v ->
  956. let udp = decode_udp v in
  957. encode_unit_result (UDP.Connected.disconnect udp)
  958. );
  959. "getPeerName", vfun1 (fun v ->
  960. let udp = decode_udp v in
  961. encode_result encode_sockaddr (UDP.Connected.getpeername udp)
  962. );
  963. "send", vfun3 (fun v1 v2 v3 ->
  964. let udp = decode_udp v1
  965. and l = decode_buffers v2 in
  966. UDP.Connected.send udp l (encode_unit_callback v3);
  967. vnull
  968. );
  969. "send", vfun2 (fun v1 v2 ->
  970. let udp = decode_udp v1
  971. and l = decode_buffers v2 in
  972. encode_unit_result (UDP.Connected.try_send udp l)
  973. );
  974. ]
  975. let pipe_fields = [
  976. "init", vfun2 (fun v1 v2 ->
  977. let loop = decode_loop v1
  978. and for_handle_passing = decode_optional decode_bool v2 in
  979. encode_result (fun p -> VHandle (HPipe p)) (Pipe.init ~loop ?for_handle_passing ())
  980. );
  981. "bind", vfun2 (fun v1 v2 ->
  982. let pipe = decode_pipe v1
  983. and name = decode_native_string v2 in
  984. encode_unit_result (Pipe.bind pipe name)
  985. );
  986. "connect", vfun3 (fun v1 v2 v3 ->
  987. let pipe = decode_pipe v1
  988. and target = decode_native_string v2 in
  989. Pipe.connect pipe target (encode_unit_callback v3);
  990. vnull
  991. );
  992. "getSockName", vfun1 (fun v ->
  993. let pipe = decode_pipe v in
  994. encode_result vnative_string (Pipe.getsockname pipe)
  995. );
  996. "getPeerName", vfun1 (fun v ->
  997. let pipe = decode_pipe v in
  998. encode_result vnative_string (Pipe.getpeername pipe)
  999. );
  1000. "pendingInstances", vfun2 (fun v1 v2 ->
  1001. let pipe = decode_pipe v1
  1002. and amount = decode_int v2 in
  1003. Pipe.pending_instances pipe amount;
  1004. vnull
  1005. );
  1006. "receiveHandle", vfun1 (fun v ->
  1007. let pipe = decode_pipe v in
  1008. let index,args =
  1009. match Pipe.receive_handle pipe with
  1010. | `None ->
  1011. 0,[||]
  1012. | `TCP assoc ->
  1013. 1,[|vfun1 (fun v -> encode_unit_result (assoc (decode_tcp v)))|]
  1014. | `Pipe assoc ->
  1015. 2,[|vfun1 (fun v -> encode_unit_result (assoc (decode_pipe v)))|]
  1016. in
  1017. encode_enum_value key_eval_luv_ReceiveHandle index args None
  1018. );
  1019. "chmod", vfun2 (fun v1 v2 ->
  1020. let pipe = decode_pipe v1
  1021. and mode =
  1022. match decode_int v2 with
  1023. | 0 -> [`READABLE]
  1024. | 1 -> [`WRITABLE]
  1025. | 2 -> [`READABLE; `WRITABLE]
  1026. | _ -> unexpected_value v2 "eval.luv.Pipe.PipeMode"
  1027. in
  1028. encode_unit_result (Pipe.chmod pipe mode)
  1029. );
  1030. ]
  1031. let tty_fields = [
  1032. "init", vfun2 (fun v1 v2 ->
  1033. let loop = decode_loop v1
  1034. and file = decode_file v2 in
  1035. encode_result (fun tty -> VHandle (HTty tty)) (TTY.init ~loop file)
  1036. );
  1037. "setMode", vfun2 (fun v1 v2 ->
  1038. let tty = decode_tty v1
  1039. and mode =
  1040. match decode_int v2 with
  1041. | 0 -> `NORMAL
  1042. | 1 -> `RAW
  1043. | 2 -> `IO
  1044. | _ -> unexpected_value v2 "eval.luv.Tty.TtyMode"
  1045. in
  1046. encode_unit_result (TTY.set_mode tty mode)
  1047. );
  1048. "resetMode", vfun0 (fun () ->
  1049. encode_unit_result (TTY.reset_mode ())
  1050. );
  1051. "getWinSize", vfun1 (fun v ->
  1052. let tty = decode_tty v in
  1053. let encode (w,h) = encode_obj [key_width,vint w; key_height,vint h] in
  1054. encode_result encode (TTY.get_winsize tty)
  1055. );
  1056. "setVTermState", vfun1 (fun v ->
  1057. let state =
  1058. match decode_int v with
  1059. | 0 -> `SUPPORTED
  1060. | 1 -> `UNSUPPORTED
  1061. | _ -> unexpected_value v "eval.luv.Tty.VTermState"
  1062. in
  1063. TTY.set_vterm_state state;
  1064. vnull
  1065. );
  1066. "getVTermState", vfun0 (fun () ->
  1067. let encode state =
  1068. vint (match state with
  1069. | `SUPPORTED -> 0
  1070. | `UNSUPPORTED -> 1)
  1071. in
  1072. encode_result encode (TTY.get_vterm_state())
  1073. );
  1074. ]
  1075. let stream_fields = [
  1076. "shutdown", vfun2 (fun v1 v2 ->
  1077. let stream = decode_stream v1 in
  1078. Stream.shutdown stream (encode_unit_callback v2);
  1079. vnull
  1080. );
  1081. "listen", vfun3 (fun v1 v2 v3 ->
  1082. let stream = decode_stream v1 in
  1083. let backlog = decode_optional (fun v -> decode_int v) v3 in
  1084. Stream.listen ?backlog stream (encode_unit_callback v2);
  1085. vnull
  1086. );
  1087. "accept", vfun2 (fun v1 v2 ->
  1088. let server = decode_stream v1
  1089. and client = decode_stream v2 in
  1090. encode_unit_result (Stream.accept server client)
  1091. );
  1092. "readStart", vfun3 (fun v1 v2 v3 ->
  1093. let stream = decode_stream v1
  1094. and callback = encode_callback encode_buffer v2
  1095. and allocate =
  1096. decode_optional (fun v ->
  1097. let cb = prepare_callback v 1 in
  1098. (fun i -> decode_buffer (cb [vint i]))
  1099. ) v3
  1100. in
  1101. Stream.read_start ?allocate stream callback;
  1102. vnull
  1103. );
  1104. "readStop", vfun1 (fun v ->
  1105. let stream = decode_stream v in
  1106. encode_unit_result (Stream.read_stop stream)
  1107. );
  1108. "write", vfun3 (fun v1 v2 v3 ->
  1109. let stream = decode_stream v1
  1110. and data = decode_buffers v2
  1111. and callback =
  1112. let cb = prepare_callback v3 2 in
  1113. (fun result bytes_written ->
  1114. ignore(cb [encode_unit_result result; vint bytes_written])
  1115. )
  1116. in
  1117. Stream.write stream data callback;
  1118. vnull
  1119. );
  1120. "write2", vfun4 (fun v1 v2 v3 v4 ->
  1121. let stream = decode_pipe v1
  1122. and data = decode_buffers v2
  1123. and callback =
  1124. let cb = prepare_callback v4 2 in
  1125. (fun result bytes_written ->
  1126. ignore(cb [encode_unit_result result; vint bytes_written])
  1127. )
  1128. in
  1129. (match decode_enum v3 with
  1130. | 0,[vh] -> Stream.write2 stream data ~send_handle:(decode_tcp vh) callback
  1131. | 1,[vh] -> Stream.write2 stream data ~send_handle:(decode_pipe vh) callback
  1132. | _ -> unexpected_value v3 "eval.luv.Stream.SendHandle"
  1133. );
  1134. vnull
  1135. );
  1136. "tryWrite", vfun2 (fun v1 v2 ->
  1137. let stream = decode_stream v1
  1138. and data = decode_buffers v2 in
  1139. encode_result vint (Stream.try_write stream data)
  1140. );
  1141. "isReadable", vfun1 (fun v ->
  1142. let stream = decode_stream v in
  1143. vbool (Stream.is_readable stream)
  1144. );
  1145. "isWritable", vfun1 (fun v ->
  1146. let stream = decode_stream v in
  1147. vbool (Stream.is_writable stream)
  1148. );
  1149. "setBlocking", vfun2 (fun v1 v2 ->
  1150. let stream = decode_stream v1
  1151. and block = decode_bool v2 in
  1152. encode_unit_result (Stream.set_blocking stream block)
  1153. );
  1154. ]
  1155. let signum_fields = [
  1156. "SIGABRT", vint Signal.sigabrt;
  1157. "SIGFPE", vint Signal.sigfpe;
  1158. "SIGHUP", vint Signal.sighup;
  1159. "SIGILL", vint Signal.sigill;
  1160. "SIGINT", vint Signal.sigint;
  1161. "SIGKILL", vint Signal.sigkill;
  1162. "SIGSEGV", vint Signal.sigsegv;
  1163. "SIGTERM", vint Signal.sigterm;
  1164. "SIGWINCH", vint Signal.sigwinch;
  1165. ]
  1166. let signal_fields = [
  1167. "init", vfun1 (fun v ->
  1168. let loop = decode_loop v in
  1169. encode_result (fun s -> VHandle (HSignal s)) (Signal.init ~loop ())
  1170. );
  1171. "start", vfun3 (fun v1 v2 v3 ->
  1172. let s = decode_signal v1
  1173. and signum = decode_int v2
  1174. and cb = prepare_callback v3 0 in
  1175. encode_unit_result (Signal.start s signum (fun() -> ignore(cb [])))
  1176. );
  1177. "startOneshot", vfun3 (fun v1 v2 v3 ->
  1178. let s = decode_signal v1
  1179. and signum = decode_int v2
  1180. and cb = prepare_callback v3 0 in
  1181. encode_unit_result (Signal.start_oneshot s signum (fun() -> ignore(cb [])))
  1182. );
  1183. "stop", vfun1 (fun v ->
  1184. let s = decode_signal v in
  1185. encode_unit_result (Signal.stop s)
  1186. );
  1187. "signum", vfun1 (fun v ->
  1188. let s = decode_signal v in
  1189. vint (Signal.signum s)
  1190. );
  1191. ]
  1192. let process_fields = [
  1193. "stdin", vint Process.stdin;
  1194. "stdout", vint Process.stdout;
  1195. "stderr", vint Process.stderr;
  1196. "toParentPipe", vfun5 (fun v1 v2 v3 v4 v5 ->
  1197. let fd = decode_int v1
  1198. and parent_pipe = decode_pipe v2
  1199. and readable_in_child = decode_bool v3
  1200. and writable_in_child = decode_bool v4
  1201. and overlapped = decode_bool v5 in
  1202. let r = Process.to_parent_pipe ~fd ~parent_pipe ~readable_in_child ~writable_in_child ~overlapped () in
  1203. VHandle (HRedirection r)
  1204. );
  1205. "inheritFd", vfun2 (fun v1 v2 ->
  1206. let fd = decode_int v1
  1207. and from_parent_fd = decode_int v2 in
  1208. let r = Process.inherit_fd ~fd ~from_parent_fd () in
  1209. VHandle (HRedirection r)
  1210. );
  1211. "inheritStream", vfun2 (fun v1 v2 ->
  1212. let fd = decode_int v1
  1213. and from_parent_stream = decode_stream v2 in
  1214. let r = Process.inherit_stream ~fd ~from_parent_stream () in
  1215. VHandle (HRedirection r)
  1216. );
  1217. "spawn", vfun4 (fun v1 v2 v3 v4 ->
  1218. let loop = decode_loop v1
  1219. and cmd = decode_native_string v2
  1220. and args = List.map decode_native_string (decode_array v3) in
  1221. let result =
  1222. if v4 = VNull then
  1223. Process.spawn ~loop cmd args
  1224. else begin
  1225. let options = decode_object v4 in
  1226. let get name_hash f =
  1227. let v = object_field options name_hash in
  1228. decode_optional f v
  1229. in
  1230. let on_exit =
  1231. get key_onExit (fun v ->
  1232. let cb = prepare_callback v 3 in
  1233. (fun p ~exit_status ~term_signal ->
  1234. ignore(cb [VHandle (HProcess p); VInt64 exit_status; vint term_signal])
  1235. )
  1236. )
  1237. and environment =
  1238. get key_environment (fun v ->
  1239. match decode_instance v with
  1240. | { ikind = IStringMap m } ->
  1241. StringHashtbl.fold (fun k (_,v) acc -> (k, decode_native_string v) :: acc) m []
  1242. | _ ->
  1243. unexpected_value v "haxe.ds.Map<String,String>"
  1244. )
  1245. and redirect =
  1246. get key_redirect (fun v ->
  1247. List.map (fun v2 ->
  1248. match v2 with
  1249. | VHandle (HRedirection r) -> r
  1250. | _ -> unexpected_value v2 "eval.luv.Process.Redirection"
  1251. ) (decode_array v)
  1252. )
  1253. and working_directory = get key_workingDirectory decode_native_string
  1254. and uid = get key_uid decode_int
  1255. and gid = get key_gid decode_int
  1256. and windows_verbatim_arguments = get key_windowsVerbatimArguments decode_bool
  1257. and detached = get key_detached decode_bool
  1258. and windows_hide = get key_windowsHide decode_bool
  1259. and windows_hide_console = get key_windowsHideConsole decode_bool
  1260. and windows_hide_gui = get key_windowsHideGui decode_bool
  1261. in
  1262. (* Process.spawn ~loop ?detached cmd args *)
  1263. Process.spawn ~loop ?on_exit ?environment ?working_directory ?redirect
  1264. ?uid ?gid ?windows_verbatim_arguments ?detached ?windows_hide
  1265. ?windows_hide_console ?windows_hide_gui cmd args
  1266. end
  1267. in
  1268. encode_result (fun p -> VHandle (HProcess p)) result
  1269. );
  1270. "disableStdioInheritance", vfun0 (fun() ->
  1271. Process.disable_stdio_inheritance();
  1272. vnull
  1273. );
  1274. "killPid", vfun2 (fun v1 v2 ->
  1275. let pid = decode_int v1
  1276. and sig_num = decode_int v2 in
  1277. encode_unit_result (Process.kill_pid ~pid sig_num)
  1278. );
  1279. "pid", vfun1 (fun v ->
  1280. let p = decode_process v in
  1281. vint (Process.pid p)
  1282. );
  1283. ]
  1284. let request_fields = [
  1285. "cancel", vfun1 (fun v ->
  1286. encode_unit_result (match v with
  1287. | VHandle (HFileRequest r) -> Request.cancel r
  1288. | VHandle (HAddrRequest r) -> Request.cancel r
  1289. | VHandle (HNameRequest r) -> Request.cancel r
  1290. | VHandle (HRandomRequest r) -> Request.cancel r
  1291. | VHandle (HThreadPoolRequest r) -> Request.cancel r
  1292. | _ -> unexpected_value v "eval.luv.Request"
  1293. )
  1294. )
  1295. ]
  1296. let dns_fields = [
  1297. "createAddrRequest", vfun0 (fun () ->
  1298. VHandle (HAddrRequest (DNS.Addr_info.Request.make()))
  1299. );
  1300. "createInfoRequest", vfun0 (fun () ->
  1301. VHandle (HNameRequest (DNS.Name_info.Request.make()))
  1302. );
  1303. "getAddrInfo", vfun5 (fun v1 v2 v3 v4 v5 ->
  1304. let loop = decode_loop v1
  1305. and node = decode_optional decode_string v2
  1306. and service = decode_optional decode_string v3
  1307. in
  1308. if node = None && service = None then
  1309. throw (create_haxe_exception "Either node or service has to be not null") null_pos
  1310. else begin
  1311. let callback =
  1312. let cb = prepare_callback v5 1 in
  1313. (fun result ->
  1314. let v =
  1315. encode_result (fun infos ->
  1316. encode_array (List.map (fun (info:DNS.Addr_info.t) ->
  1317. let fields = [
  1318. key_family,encode_address_family info.family;
  1319. key_sockType,encode_socket_type info.socktype;
  1320. key_protocol,vint info.protocol;
  1321. key_addr,encode_sockaddr info.addr;
  1322. ] in
  1323. let fields =
  1324. match info.canonname with
  1325. | None -> fields
  1326. | Some s -> (key_canonName,EvalString.create_unknown s) :: fields
  1327. in
  1328. encode_obj fields
  1329. ) infos)
  1330. ) result
  1331. in
  1332. ignore(cb [v])
  1333. )
  1334. in
  1335. if v4 = VNull then
  1336. DNS.getaddrinfo ~loop ?node ?service () callback
  1337. else begin
  1338. let options = decode_object v4 in
  1339. let get name_hash f =
  1340. let v = object_field options name_hash in
  1341. decode_optional f v
  1342. in
  1343. let request =
  1344. get key_request (function
  1345. | VHandle (HAddrRequest r) -> r
  1346. | v -> unexpected_value v "eval.luv.Dns.AddrInfoRequest"
  1347. )
  1348. and family = get key_family decode_address_family
  1349. and socktype = get key_sockType decode_socket_type
  1350. and protocol = get key_protocol decode_int
  1351. and flags =
  1352. get key_flags (fun v ->
  1353. List.map (fun v ->
  1354. match decode_int v with
  1355. | 0 -> `PASSIVE
  1356. | 1 -> `CANONNAME
  1357. | 2 -> `NUMERICHOST
  1358. | 3 -> `NUMERICSERV
  1359. | 4 -> `V4MAPPED
  1360. | 5 -> `ALL
  1361. | 6 -> `ADDRCONFIG
  1362. | _ -> unexpected_value v "eval.luv.Dns.AddrInfoFlag"
  1363. ) (decode_array v)
  1364. )
  1365. in
  1366. DNS.getaddrinfo ~loop ?request ?family ?socktype ?protocol ?flags ?service ?node () callback
  1367. end;
  1368. vnull
  1369. end
  1370. );
  1371. "getNameInfo", vfun4 (fun v1 v2 v3 v4 ->
  1372. let loop = decode_loop v1
  1373. and addr = decode_sockaddr v2
  1374. and callback =
  1375. let cb = prepare_callback v4 1 in
  1376. (fun result ->
  1377. let v =
  1378. encode_result (fun (node,service) ->
  1379. encode_obj [
  1380. key_node,encode_string node;
  1381. key_service,encode_string service;
  1382. ]
  1383. ) result
  1384. in
  1385. ignore(cb [v])
  1386. )
  1387. in
  1388. if v3 = VNull then
  1389. DNS.getnameinfo ~loop addr callback
  1390. else begin
  1391. let options = decode_object v3 in
  1392. let get name_hash f =
  1393. let v = object_field options name_hash in
  1394. decode_optional f v
  1395. in
  1396. let request =
  1397. get key_request (function
  1398. | VHandle (HNameRequest r) -> r
  1399. | v -> unexpected_value v "eval.luv.Dns.NameInfoRequest"
  1400. )
  1401. and flags =
  1402. get key_flags (fun v ->
  1403. List.map (fun v ->
  1404. match decode_int v with
  1405. | 0 -> `NAMEREQD
  1406. | 1 -> `DGRAM
  1407. | 2 -> `NOFQDN
  1408. | 3 -> `NUMERICHOST
  1409. | 4 -> `NUMERICSERV
  1410. | _ -> unexpected_value v "eval.luv.Dns.NameInfoFlag"
  1411. ) (decode_array v)
  1412. )
  1413. in
  1414. DNS.getnameinfo ~loop ?request ?flags addr callback
  1415. end;
  1416. vnull
  1417. );
  1418. ]
  1419. module F = struct
  1420. let async ~vloop ~vrequest fn =
  1421. let loop = Some (decode_loop vloop)
  1422. and request = decode_optional decode_file_request vrequest in
  1423. fn ?loop ?request
  1424. let path ~vpath fn =
  1425. fn (decode_native_string vpath)
  1426. let file ~vfile fn =
  1427. fn (decode_file vfile)
  1428. let dir ~vdir fn =
  1429. fn (decode_dir vdir)
  1430. let to_ ~vto fn =
  1431. let to_ = decode_native_string vto in
  1432. fn ~to_
  1433. let mode ~vmode fn =
  1434. fn (decode_file_mode_list vmode)
  1435. let mode_opt ~vmode fn =
  1436. let mode = decode_optional decode_file_mode_list vmode in
  1437. fn ?mode
  1438. let open_ ~vmode ~vpath ~vflags fn =
  1439. let flags = List.map decode_file_open_flag (decode_array vflags) in
  1440. (fn |> mode_opt ~vmode |> path ~vpath) flags
  1441. let rename ~vpath ~vto fn =
  1442. fn |> path ~vpath |> to_ ~vto
  1443. let mkdir ~vmode ~vpath fn =
  1444. fn |> mode_opt ~vmode |> path ~vpath
  1445. let data ~vfile_offset ~vfile ~vbuffers fn =
  1446. let file = decode_file vfile
  1447. and file_offset = Some (decode_i64 vfile_offset)
  1448. and buffers = decode_buffers vbuffers in
  1449. fn ?file_offset file buffers
  1450. let ftruncate ~vfile ~vlength fn =
  1451. let file = decode_file vfile
  1452. and length = decode_i64 vlength in
  1453. fn file length
  1454. let copyFile ~vflags ~vpath ~vto fn =
  1455. let flags = decode_int_flags vflags in
  1456. let excl = if List.mem 0 flags then Some true else None
  1457. and ficlone = if List.mem 1 flags then Some true else None
  1458. and ficlone_force = if List.mem 2 flags then Some true else None in
  1459. (fn ?excl ?ficlone ?ficlone_force) |> path ~vpath |> to_ ~vto
  1460. let sendFile ~vfile ~vto ~voffset ~vlength fn =
  1461. let to_ = decode_file vto
  1462. and offset = decode_i64 voffset
  1463. and length = decode_size_t vlength in
  1464. (fn |> file ~vfile) ~to_ ~offset length
  1465. let access ~vpath ~vflags fn =
  1466. let flags =
  1467. List.map (fun v ->
  1468. match decode_int v with
  1469. | 0 -> `F_OK
  1470. | 1 -> `R_OK
  1471. | 2 -> `W_OK
  1472. | 3 -> `X_OK
  1473. | _ -> unexpected_value v "eval.luv.File.FileAccessFlag"
  1474. ) (decode_array vflags) in
  1475. (fn |> path ~vpath) flags
  1476. let utime ~vatime ~vmtime fn =
  1477. let atime = num vatime
  1478. and mtime = num vmtime in
  1479. fn ~atime ~mtime
  1480. let link ~vlink fn =
  1481. let link = decode_native_string vlink in
  1482. fn ~link
  1483. let symlink ~vflags fn =
  1484. let flags = decode_int_flags vflags in
  1485. let dir = if List.mem 0 flags then Some true else None
  1486. and junction = if List.mem 1 flags then Some true else None in
  1487. fn ?dir ?junction
  1488. let chown ~vuid ~vgid fn =
  1489. let uid = decode_int vuid
  1490. and gid = decode_int vgid in
  1491. fn ~uid ~gid
  1492. let readdir ~vdir ~vnumber_of_entries fn =
  1493. let number_of_entries = decode_optional decode_int vnumber_of_entries in
  1494. fn ?number_of_entries |> dir ~vdir
  1495. end
  1496. let file_fields = [
  1497. "stdin", VHandle (HFile File.stdin);
  1498. "stdout", VHandle (HFile File.stdout);
  1499. "stderr", VHandle (HFile File.stderr);
  1500. "createRequest", vfun0 (fun() ->
  1501. VHandle (HFileRequest (File.Request.make()))
  1502. );
  1503. "testMode", vfun2 (fun v1 v2 ->
  1504. let mask = decode_file_mode_list v1
  1505. and bits =
  1506. match v2 with
  1507. | VHandle (HFileModeNumeric m) -> m
  1508. | _ -> unexpected_value v2 "eval.luv.File.FileModeNumeric"
  1509. in
  1510. vbool (File.Mode.test mask bits)
  1511. );
  1512. "open", vfun6 (fun vloop vpath vflags vmode vrequest vcallback ->
  1513. let callback = encode_callback (fun f -> VHandle (HFile f)) vcallback in
  1514. (File.open_ |> F.async ~vloop ~vrequest |> F.open_ ~vmode ~vpath ~vflags) callback;
  1515. vnull
  1516. );
  1517. "close", vfun4 (fun vfile vloop vrequest vcallback ->
  1518. let callback = encode_unit_callback vcallback in
  1519. (File.close |> F.async ~vloop ~vrequest |> F.file ~vfile) callback;
  1520. vnull
  1521. );
  1522. "read", vfun6 (fun vfile vloop vfile_offset vbuffers vrequest vcallback ->
  1523. let callback = encode_callback encode_size_t vcallback in
  1524. (File.read |> F.async ~vloop ~vrequest |> F.data ~vfile_offset ~vfile ~vbuffers) callback;
  1525. vnull
  1526. );
  1527. "write", vfun6 (fun vfile vloop vfile_offset vbuffers vrequest vcallback ->
  1528. let callback = encode_callback encode_size_t vcallback in
  1529. (File.write |> F.async ~vloop ~vrequest |> F.data ~vfile_offset ~vfile ~vbuffers) callback;
  1530. vnull
  1531. );
  1532. "unlink", vfun4 (fun vloop vpath vrequest vcallback ->
  1533. let callback = encode_unit_callback vcallback in
  1534. (File.unlink |> F.async ~vloop ~vrequest |> F.path ~vpath) callback;
  1535. vnull
  1536. );
  1537. "rename", vfun5 (fun vloop vpath vto vrequest vcallback ->
  1538. let callback = encode_unit_callback vcallback in
  1539. (File.rename |> F.async ~vloop ~vrequest |> F.rename ~vpath ~vto) callback;
  1540. vnull
  1541. );
  1542. "mkstemp", vfun4 (fun vloop vpath vrequest vcallback ->
  1543. let callback =
  1544. encode_callback (fun (n,file) ->
  1545. encode_obj [key_name,vnative_string n; key_file,VHandle (HFile file)]
  1546. ) vcallback
  1547. in
  1548. (File.mkstemp |> F.async ~vloop ~vrequest |> F.path ~vpath) callback;
  1549. vnull
  1550. );
  1551. "mkdtemp", vfun4 (fun vloop vpath vrequest vcallback ->
  1552. let callback = encode_callback vnative_string vcallback in
  1553. (File.mkdtemp |> F.async ~vloop ~vrequest |> F.path ~vpath) callback;
  1554. vnull
  1555. );
  1556. "mkdir", vfun5 (fun vloop vpath vmode vrequest vcallback ->
  1557. let callback = encode_unit_callback vcallback in
  1558. (File.mkdir |> F.async ~vloop ~vrequest |> F.mkdir ~vmode ~vpath) callback;
  1559. vnull
  1560. );
  1561. "rmdir", vfun4 (fun vloop vpath vrequest vcallback ->
  1562. let callback = encode_unit_callback vcallback in
  1563. (File.rmdir |> F.async ~vloop ~vrequest |> F.path ~vpath) callback;
  1564. vnull
  1565. );
  1566. "stat", vfun4 (fun vloop vpath vrequest vcallback ->
  1567. let callback = encode_callback encode_file_stat vcallback in
  1568. (File.stat |> F.async ~vloop ~vrequest |> F.path ~vpath) callback;
  1569. vnull
  1570. );
  1571. "lstat", vfun4 (fun vloop vpath vrequest vcallback ->
  1572. let callback = encode_callback encode_file_stat vcallback in
  1573. (File.lstat |> F.async ~vloop ~vrequest |> F.path ~vpath) callback;
  1574. vnull
  1575. );
  1576. "fstat", vfun4 (fun vfile vloop vrequest vcallback ->
  1577. let callback = encode_callback encode_file_stat vcallback in
  1578. (File.fstat |> F.async ~vloop ~vrequest |> F.file ~vfile) callback;
  1579. vnull
  1580. );
  1581. "statFs", vfun4 (fun vloop vpath vrequest vcallback ->
  1582. let callback = encode_callback encode_file_statfs vcallback in
  1583. (File.statfs |> F.async ~vloop ~vrequest |> F.path ~vpath) callback;
  1584. vnull
  1585. );
  1586. "fsync", vfun4 (fun vfile vloop vrequest vcallback ->
  1587. let callback = encode_unit_callback vcallback in
  1588. (File.fsync |> F.async ~vloop ~vrequest |> F.file ~vfile) callback;
  1589. vnull
  1590. );
  1591. "fdataSync", vfun4 (fun vfile vloop vrequest vcallback ->
  1592. let callback = encode_unit_callback vcallback in
  1593. (File.fdatasync |> F.async ~vloop ~vrequest |> F.file ~vfile) callback;
  1594. vnull
  1595. );
  1596. "ftruncate", vfun5 (fun vfile vloop vlength vrequest vcallback ->
  1597. let callback = encode_unit_callback vcallback in
  1598. (File.ftruncate |> F.async ~vloop ~vrequest |> F.ftruncate ~vfile ~vlength) callback;
  1599. vnull
  1600. );
  1601. "copyFile", vfun6 (fun vloop vpath vto vflags vrequest vcallback ->
  1602. let callback = encode_unit_callback vcallback in
  1603. (File.copyfile |> F.async ~vloop ~vrequest |> F.copyFile ~vflags ~vpath ~vto) callback;
  1604. vnull
  1605. );
  1606. "sendFile", vfun7 (fun vfile vloop vto voffset vlength vrequest vcallback ->
  1607. let callback = encode_callback encode_size_t vcallback in
  1608. (File.sendfile |> F.async ~vloop ~vrequest |> F.sendFile ~vfile ~vto ~voffset ~vlength) callback;
  1609. vnull
  1610. );
  1611. "access", vfun5 (fun vloop vpath vflags vrequest vcallback ->
  1612. let callback = encode_unit_callback vcallback in
  1613. (File.access |> F.async ~vloop ~vrequest |> F.access ~vpath ~vflags) callback;
  1614. vnull
  1615. );
  1616. "chmod", vfun5 (fun vloop vpath vmode vrequest vcallback ->
  1617. let callback = encode_unit_callback vcallback in
  1618. (File.chmod |> F.async ~vloop ~vrequest |> F.path ~vpath |> F.mode ~vmode) callback;
  1619. vnull
  1620. );
  1621. "fchmod", vfun5 (fun vfile vloop vmode vrequest vcallback ->
  1622. let callback = encode_unit_callback vcallback in
  1623. (File.fchmod |> F.async ~vloop ~vrequest |> F.file ~vfile |> F.mode ~vmode) callback;
  1624. vnull
  1625. );
  1626. "utime", vfun6 (fun vloop vpath vatime vmtime vrequest vcallback ->
  1627. let callback = encode_unit_callback vcallback in
  1628. (File.utime |> F.async ~vloop ~vrequest |> F.path ~vpath |> F.utime ~vatime ~vmtime) callback;
  1629. vnull
  1630. );
  1631. "lutime", vfun6 (fun vloop vpath vatime vmtime vrequest vcallback ->
  1632. let callback = encode_unit_callback vcallback in
  1633. (File.lutime |> F.async ~vloop ~vrequest |> F.path ~vpath |> F.utime ~vatime ~vmtime) callback;
  1634. vnull
  1635. );
  1636. "futime", vfun6 (fun vfile vloop vatime vmtime vrequest vcallback ->
  1637. let callback = encode_unit_callback vcallback in
  1638. (File.futime |> F.async ~vloop ~vrequest |> F.file ~vfile |> F.utime ~vatime ~vmtime) callback;
  1639. vnull
  1640. );
  1641. "link", vfun5 (fun vloop vpath vlink vrequest vcallback ->
  1642. let callback = encode_unit_callback vcallback in
  1643. (File.link |> F.async ~vloop ~vrequest |> F.path ~vpath |> F.link ~vlink) callback;
  1644. vnull
  1645. );
  1646. "symlink", vfun6 (fun vloop vpath vlink vflags vrequest vcallback ->
  1647. let callback = encode_unit_callback vcallback in
  1648. (File.symlink |> F.async ~vloop ~vrequest |> F.symlink ~vflags |> F.path ~vpath |> F.link ~vlink) callback;
  1649. vnull
  1650. );
  1651. "readLink", vfun4 (fun vloop vpath vrequest v4 ->
  1652. let callback = encode_callback vnative_string v4 in
  1653. (File.readlink |> F.async ~vloop ~vrequest |> F.path ~vpath) callback;
  1654. vnull
  1655. );
  1656. "realPath", vfun4 (fun vloop vpath vrequest v4 ->
  1657. let callback = encode_callback vnative_string v4 in
  1658. (File.realpath |> F.async ~vloop ~vrequest |> F.path ~vpath) callback;
  1659. vnull
  1660. );
  1661. "chown", vfun6 (fun vloop vpath vuid vgid vrequest vcallback ->
  1662. let callback = encode_unit_callback vcallback in
  1663. (File.chown |> F.async ~vloop ~vrequest |> F.path ~vpath |> F.chown ~vuid ~vgid) callback;
  1664. vnull
  1665. );
  1666. "lchown", vfun6 (fun vloop vpath vuid vgid vrequest vcallback ->
  1667. let callback = encode_unit_callback vcallback in
  1668. (File.lchown |> F.async ~vloop ~vrequest |> F.path ~vpath |> F.chown ~vuid ~vgid) callback;
  1669. vnull
  1670. );
  1671. "fchown", vfun6 (fun vfile vloop vuid vgid vrequest vcallback ->
  1672. let callback = encode_unit_callback vcallback in
  1673. (File.fchown |> F.async ~vloop ~vrequest |> F.file ~vfile |> F.chown ~vuid ~vgid) callback;
  1674. vnull
  1675. );
  1676. "toInt", vfun1 (fun v ->
  1677. let file = decode_file v in
  1678. vint (File.to_int file)
  1679. );
  1680. ]
  1681. let file_sync_fields = [
  1682. "open", vfun3 (fun vpath vflags vmode ->
  1683. File.Sync.open_ |> F.open_ ~vmode ~vpath ~vflags |> encode_result (fun f -> VHandle (HFile f))
  1684. );
  1685. "close", vfun1 (fun vfile ->
  1686. File.Sync.close |> F.file ~vfile |> encode_unit_result
  1687. );
  1688. "read", vfun3 (fun vfile vfile_offset vbuffers ->
  1689. File.Sync.read |> F.data ~vfile_offset ~vfile ~vbuffers |> encode_result encode_size_t
  1690. );
  1691. "write", vfun3 (fun vfile vfile_offset vbuffers ->
  1692. File.Sync.write |> F.data ~vfile_offset ~vfile ~vbuffers |> encode_result encode_size_t
  1693. );
  1694. "unlink", vfun1 (fun vpath ->
  1695. File.Sync.unlink |> F.path ~vpath |> encode_unit_result
  1696. );
  1697. "rename", vfun2 (fun vpath vto ->
  1698. File.Sync.rename |> F.rename ~vpath ~vto |> encode_unit_result
  1699. );
  1700. "mkstemp", vfun1 (fun vpath ->
  1701. let encode (n,file) =
  1702. encode_obj [key_name,vnative_string n; key_file,VHandle (HFile file)]
  1703. in
  1704. File.Sync.mkstemp |> F.path ~vpath |> encode_result encode
  1705. );
  1706. "mkdtemp", vfun1 (fun vpath ->
  1707. File.Sync.mkdtemp |> F.path ~vpath |> encode_result vnative_string
  1708. );
  1709. "mkdir", vfun2 (fun vpath vmode ->
  1710. File.Sync.mkdir |> F.mkdir ~vmode ~vpath |> encode_unit_result
  1711. );
  1712. "rmdir", vfun1 (fun vpath ->
  1713. File.Sync.rmdir |> F.path ~vpath |> encode_unit_result
  1714. );
  1715. "stat", vfun1 (fun vpath ->
  1716. File.Sync.stat |> F.path ~vpath |> encode_result encode_file_stat
  1717. );
  1718. "lstat", vfun1 (fun vpath ->
  1719. File.Sync.lstat |> F.path ~vpath |> encode_result encode_file_stat
  1720. );
  1721. "fstat", vfun1 (fun vfile ->
  1722. File.Sync.fstat |> F.file ~vfile |> encode_result encode_file_stat
  1723. );
  1724. "statFs", vfun1 (fun vpath ->
  1725. File.Sync.statfs |> F.path ~vpath |> encode_result encode_file_statfs
  1726. );
  1727. "fsync", vfun1 (fun vfile ->
  1728. File.Sync.fsync |> F.file ~vfile |> encode_unit_result
  1729. );
  1730. "fdataSync", vfun1 (fun vfile ->
  1731. File.Sync.fdatasync |> F.file ~vfile |> encode_unit_result
  1732. );
  1733. "ftruncate", vfun2 (fun vfile vlength ->
  1734. File.Sync.ftruncate |> F.ftruncate ~vfile ~vlength |> encode_unit_result
  1735. );
  1736. "copyFile", vfun3 (fun vpath vto vflags ->
  1737. File.Sync.copyfile |> F.copyFile ~vflags ~vpath ~vto |> encode_unit_result
  1738. );
  1739. "sendFile", vfun4 (fun vfile vto voffset vlength ->
  1740. File.Sync.sendfile |> F.sendFile ~vfile ~vto ~voffset ~vlength |> encode_result encode_size_t
  1741. );
  1742. "access", vfun2 (fun vpath vflags ->
  1743. File.Sync.access |> F.access ~vpath ~vflags |> encode_unit_result
  1744. );
  1745. "chmod", vfun2 (fun vpath vmode ->
  1746. File.Sync.chmod |> F.path ~vpath |> F.mode ~vmode |> encode_unit_result
  1747. );
  1748. "fchmod", vfun2 (fun vfile vmode ->
  1749. File.Sync.fchmod |> F.file ~vfile |> F.mode ~vmode |> encode_unit_result
  1750. );
  1751. "utime", vfun3 (fun vpath vatime vmtime ->
  1752. File.Sync.utime |> F.path ~vpath |> F.utime ~vatime ~vmtime |> encode_unit_result
  1753. );
  1754. "lutime", vfun3 (fun vpath vatime vmtime ->
  1755. File.Sync.lutime |> F.path ~vpath |> F.utime ~vatime ~vmtime |> encode_unit_result
  1756. );
  1757. "futime", vfun3 (fun vfile vatime vmtime ->
  1758. File.Sync.futime |> F.file ~vfile |> F.utime ~vatime ~vmtime |> encode_unit_result
  1759. );
  1760. "link", vfun2 (fun vpath vlink ->
  1761. File.Sync.link |> F.path ~vpath |> F.link ~vlink |> encode_unit_result
  1762. );
  1763. "symlink", vfun3 (fun vpath vlink vflags ->
  1764. File.Sync.symlink |> F.symlink ~vflags |> F.path ~vpath |> F.link ~vlink |> encode_unit_result
  1765. );
  1766. "readLink", vfun1 (fun vpath ->
  1767. File.Sync.readlink |> F.path ~vpath |> encode_result vnative_string
  1768. );
  1769. "realPath", vfun1 (fun vpath ->
  1770. File.Sync.realpath |> F.path ~vpath |> encode_result vnative_string
  1771. );
  1772. "chown", vfun3 (fun vpath vuid vgid ->
  1773. File.Sync.chown |> F.path ~vpath |> F.chown ~vuid ~vgid |> encode_unit_result
  1774. );
  1775. "lchown", vfun3 (fun vpath vuid vgid ->
  1776. File.Sync.lchown |> F.path ~vpath |> F.chown ~vuid ~vgid |> encode_unit_result
  1777. );
  1778. "fchown", vfun3 (fun vfile vuid vgid ->
  1779. File.Sync.fchown |> F.file ~vfile |> F.chown ~vuid ~vgid |> encode_unit_result
  1780. );
  1781. ]
  1782. let dir_fields = [
  1783. "open", vfun4 (fun vloop vpath vrequest vcallback ->
  1784. let callback = encode_callback (fun dir -> VHandle (HDir dir)) vcallback in
  1785. (File.opendir |> F.async ~vloop ~vrequest |> F.path ~vpath) callback;
  1786. vnull
  1787. );
  1788. "close", vfun4 (fun vdir vloop vrequest vcallback ->
  1789. let callback = encode_unit_callback vcallback in
  1790. (File.closedir |> F.async ~vloop ~vrequest |> F.dir ~vdir) callback;
  1791. vnull
  1792. );
  1793. "read", vfun5 (fun vdir vloop vnumber_of_entries vrequest vcallback ->
  1794. let callback =
  1795. encode_callback (fun a ->
  1796. encode_array_a (Array.map encode_dirent a)
  1797. ) vcallback
  1798. in
  1799. (File.readdir |> F.async ~vloop ~vrequest |> F.readdir ~vnumber_of_entries ~vdir) callback;
  1800. vnull
  1801. );
  1802. "scan", vfun4 (fun vloop vpath vrequest vcallback ->
  1803. let callback = encode_callback encode_scandir vcallback in
  1804. (File.scandir |> F.async ~vloop ~vrequest |> F.path ~vpath) callback;
  1805. vnull
  1806. );
  1807. ]
  1808. let dir_sync_fields = [
  1809. "open", vfun1 (fun vpath ->
  1810. File.Sync.opendir |> F.path ~vpath |> encode_result (fun dir -> VHandle (HDir dir))
  1811. );
  1812. "close", vfun1 (fun vdir ->
  1813. File.Sync.closedir |> F.dir ~vdir |> encode_unit_result
  1814. );
  1815. "read", vfun2 (fun vdir vnumber_of_entries ->
  1816. let encode a =
  1817. encode_array_a (Array.map encode_dirent a)
  1818. in
  1819. File.Sync.readdir |> F.readdir ~vnumber_of_entries ~vdir |> encode_result encode
  1820. );
  1821. "scan", vfun1 (fun vpath ->
  1822. File.Sync.scandir |> F.path ~vpath |> encode_result encode_scandir
  1823. );
  1824. ]
  1825. let fs_event_fields = [
  1826. "init", vfun1 (fun v ->
  1827. let loop = decode_loop v in
  1828. encode_result (fun e -> VHandle (HFsEvent e)) (FS_event.init ~loop ())
  1829. );
  1830. "start", vfun4 (fun v1 v2 v3 v4 ->
  1831. let event = decode_fs_event v1
  1832. and path = decode_native_string v2
  1833. and callback =
  1834. encode_callback (fun (file,events) ->
  1835. let vevents =
  1836. List.map (fun (e:FS_event.Event.t) ->
  1837. match e with
  1838. | `RENAME -> vint 0
  1839. | `CHANGE -> vint 1
  1840. ) events
  1841. in
  1842. encode_obj [
  1843. key_file,vnative_string file;
  1844. key_events,encode_array vevents;
  1845. ]
  1846. ) v4
  1847. in
  1848. if v3 = VNull then
  1849. FS_event.start event path callback
  1850. else begin
  1851. let flags = decode_int_flags v3 in
  1852. let watch_entry = List.mem 0 flags
  1853. and stat = List.mem 1 flags
  1854. and recursive = List.mem 2 flags in
  1855. FS_event.start ~watch_entry ~stat ~recursive event path callback
  1856. end;
  1857. vnull
  1858. );
  1859. "stop", vfun1 (fun v ->
  1860. let event = decode_fs_event v in
  1861. encode_unit_result (FS_event.stop event)
  1862. );
  1863. ]
  1864. let thread_pool_fields = [
  1865. "createRequest", vfun0 (fun() ->
  1866. VHandle (HThreadPoolRequest (Thread_pool.Request.make()))
  1867. );
  1868. "queueWork", vfun4 (fun v1 v2 v3 v4 ->
  1869. let loop = decode_loop v1
  1870. and request =
  1871. decode_optional (function
  1872. | VHandle (HThreadPoolRequest r) -> r
  1873. | v -> unexpected_value v "eval.luv.ThreadPool.ThreadPoolRequest"
  1874. ) v2
  1875. and work =
  1876. let cb = prepare_callback v3 0 in
  1877. (fun() -> EvalThread.run (get_ctx()) (fun() -> cb []))
  1878. and callback = encode_unit_callback v4 in
  1879. Thread_pool.queue_work ~loop ?request work callback;
  1880. vnull
  1881. );
  1882. "setSize", vfun2 (fun v1 v2 ->
  1883. let size = decode_int v1
  1884. and if_not_already_set = decode_optional decode_bool v2 in
  1885. Thread_pool.set_size ?if_not_already_set size;
  1886. vnull
  1887. );
  1888. ]
  1889. let thread_fields = [
  1890. "self", vfun0 (fun() ->
  1891. VHandle (HThread (Thread.self()))
  1892. );
  1893. "create", vfun2 (fun v1 v2 ->
  1894. let fn =
  1895. let cb = prepare_callback v1 0 in
  1896. (fun() -> EvalThread.run (get_ctx()) (fun() -> cb []))
  1897. and stack_size = decode_optional decode_int v2 in
  1898. encode_result (fun t -> VHandle (HThread t)) (Thread.create ?stack_size fn)
  1899. );
  1900. "join", vfun1 (fun v ->
  1901. let thread =
  1902. match v with
  1903. | VHandle (HThread t) -> t
  1904. | _ -> unexpected_value v "eval.luv.Thread"
  1905. in
  1906. encode_unit_result (Thread.join thread)
  1907. );
  1908. ]
  1909. let once_fields = [
  1910. "init", vfun0 (fun() ->
  1911. encode_result (fun o -> VHandle (HOnce o)) (Once.init())
  1912. );
  1913. "once", vfun2 (fun v1 v2 ->
  1914. let once =
  1915. match v1 with
  1916. | VHandle (HOnce o) -> o
  1917. | _ -> unexpected_value v1 "eval.luv.Once"
  1918. and callback = prepare_callback v2 0 in
  1919. Once.once once (fun() -> ignore(callback []));
  1920. vnull
  1921. );
  1922. ]
  1923. let mutex_fields = [
  1924. "init", vfun1 (fun v ->
  1925. let recursive = decode_optional decode_bool v in
  1926. encode_result (fun m -> VHandle (HMutex m)) (Mutex.init ?recursive ())
  1927. );
  1928. "destroy", vfun1 (fun v ->
  1929. Mutex.destroy (decode_mutex v);
  1930. vnull
  1931. );
  1932. "lock", vfun1 (fun v ->
  1933. Mutex.lock (decode_mutex v);
  1934. vnull
  1935. );
  1936. "tryLock", vfun1 (fun v ->
  1937. encode_unit_result (Mutex.trylock (decode_mutex v))
  1938. );
  1939. "unlock", vfun1 (fun v ->
  1940. Mutex.unlock (decode_mutex v);
  1941. vnull
  1942. );
  1943. ]
  1944. let rwlock_fields = [
  1945. "init", vfun0 (fun() ->
  1946. encode_result (fun l -> VHandle (HRwLock l)) (Rwlock.init())
  1947. );
  1948. "destroy", vfun1 (fun v ->
  1949. Rwlock.destroy (decode_rwlock v);
  1950. vnull
  1951. );
  1952. "rdLock", vfun1 (fun v ->
  1953. Rwlock.rdlock (decode_rwlock v);
  1954. vnull
  1955. );
  1956. "rdTryLock", vfun1 (fun v ->
  1957. encode_unit_result (Rwlock.tryrdlock (decode_rwlock v))
  1958. );
  1959. "rdUnlock", vfun1 (fun v ->
  1960. Rwlock.rdunlock (decode_rwlock v);
  1961. vnull
  1962. );
  1963. "wrLock", vfun1 (fun v ->
  1964. Rwlock.wrlock (decode_rwlock v);
  1965. vnull
  1966. );
  1967. "wrTryLock", vfun1 (fun v ->
  1968. encode_unit_result (Rwlock.trywrlock (decode_rwlock v))
  1969. );
  1970. "wrUnlock", vfun1 (fun v ->
  1971. Rwlock.wrunlock (decode_rwlock v);
  1972. vnull
  1973. );
  1974. ]
  1975. let semaphore_fields = [
  1976. "init", vfun1 (fun v ->
  1977. encode_result (fun s -> VHandle (HSemaphore s)) (Semaphore.init (decode_int v))
  1978. );
  1979. "destroy", vfun1 (fun v ->
  1980. Semaphore.destroy (decode_semaphore v);
  1981. vnull
  1982. );
  1983. "post", vfun1 (fun v ->
  1984. Semaphore.post (decode_semaphore v);
  1985. vnull
  1986. );
  1987. "wait", vfun1 (fun v ->
  1988. Semaphore.wait (decode_semaphore v);
  1989. vnull
  1990. );
  1991. "tryWait", vfun1 (fun v ->
  1992. encode_unit_result (Semaphore.trywait (decode_semaphore v))
  1993. );
  1994. ]
  1995. let condition_fields = [
  1996. "init", vfun0 (fun() ->
  1997. encode_result (fun s -> VHandle (HCondition s)) (Condition.init ())
  1998. );
  1999. "destroy", vfun1 (fun v ->
  2000. Condition.destroy (decode_condition v);
  2001. vnull
  2002. );
  2003. "signal", vfun1 (fun v ->
  2004. Condition.signal (decode_condition v);
  2005. vnull
  2006. );
  2007. "broadcast", vfun1 (fun v ->
  2008. Condition.broadcast (decode_condition v);
  2009. vnull
  2010. );
  2011. "wait", vfun2 (fun v1 v2 ->
  2012. let condition = decode_condition v1
  2013. and mutex = decode_mutex v2 in
  2014. Condition.wait condition mutex;
  2015. vnull
  2016. );
  2017. "timedWait", vfun3 (fun v1 v2 v3 ->
  2018. let condition = decode_condition v1
  2019. and mutex = decode_mutex v2
  2020. and timeout = decode_int v3 in
  2021. encode_unit_result (Condition.timedwait condition mutex timeout)
  2022. );
  2023. ]
  2024. let barrier_fields = [
  2025. "init", vfun1 (fun v ->
  2026. encode_result (fun b -> VHandle (HBarrier b)) (Barrier.init (decode_int v))
  2027. );
  2028. "destroy", vfun1 (fun v ->
  2029. Barrier.destroy (decode_barrier v);
  2030. vnull
  2031. );
  2032. "wait", vfun1 (fun v ->
  2033. vbool (Barrier.wait (decode_barrier v))
  2034. );
  2035. ]
  2036. let env_fields = [
  2037. "getEnv", vfun1 (fun v ->
  2038. let name = decode_string v in
  2039. encode_result vnative_string (Env.getenv name)
  2040. );
  2041. "setEnv", vfun2 (fun v1 v2 ->
  2042. let name = decode_string v1
  2043. and value = decode_native_string v2 in
  2044. encode_unit_result (Env.setenv name ~value)
  2045. );
  2046. "unsetEnv", vfun1 (fun v ->
  2047. let name = decode_string v in
  2048. encode_unit_result (Env.unsetenv name)
  2049. );
  2050. "environ", vfun0 (fun() ->
  2051. let encode env =
  2052. let map =
  2053. List.fold_left (fun map (name,value) ->
  2054. StringHashtbl.add map (EvalString.create_unknown_vstring name) (vnative_string value);
  2055. map
  2056. ) (StringHashtbl.create()) env
  2057. in
  2058. encode_string_map_direct map
  2059. in
  2060. encode_result encode (Env.environ())
  2061. );
  2062. ]
  2063. let time_fields = [
  2064. "getTimeOfDay", vfun0 (fun() ->
  2065. encode_result (fun (t:Time.t) ->
  2066. encode_obj [key_sec,VInt64 t.tv_sec; key_usec,vint32 t.tv_usec]
  2067. ) (Time.gettimeofday())
  2068. );
  2069. "hrTime", vfun0 (fun() ->
  2070. VUInt64 (Time.hrtime())
  2071. );
  2072. "sleep", vfun1 (fun v ->
  2073. Time.sleep (decode_int v);
  2074. vnull
  2075. );
  2076. ]
  2077. let path_fields = [
  2078. "exePath", vfun0 (fun() ->
  2079. encode_result vnative_string (Path.exepath())
  2080. );
  2081. "cwd", vfun0 (fun() ->
  2082. encode_result vnative_string (Path.cwd())
  2083. );
  2084. "chdir", vfun1 (fun v ->
  2085. encode_unit_result (Path.chdir (decode_native_string v))
  2086. );
  2087. "homedir", vfun0 (fun() ->
  2088. encode_result vnative_string (Path.homedir())
  2089. );
  2090. "tmpdir", vfun0 (fun() ->
  2091. encode_result vnative_string (Path.tmpdir())
  2092. );
  2093. ]
  2094. let random_fields = [
  2095. "createRequest", vfun0 (fun() ->
  2096. VHandle (HRandomRequest (Random.Request.make()))
  2097. );
  2098. "random", vfun4 (fun v1 v2 v3 v4 ->
  2099. let loop = decode_loop v1
  2100. and buffer = decode_buffer v2
  2101. and request =
  2102. decode_optional (function
  2103. | VHandle (HRandomRequest r) -> r
  2104. | v -> unexpected_value v "eval.luv.Random.RandomRequest"
  2105. ) v3
  2106. and callback = encode_unit_callback v4 in
  2107. Random.random ~loop ?request buffer callback;
  2108. vnull
  2109. );
  2110. ]
  2111. let random_sync_fields = [
  2112. "random", vfun1(fun v ->
  2113. let buffer = decode_buffer v in
  2114. encode_unit_result (Random.Sync.random buffer)
  2115. );
  2116. ]
  2117. let network_fields = [
  2118. "interfaceAddresses", vfun0 (fun() ->
  2119. encode_result (fun addresses ->
  2120. encode_array (List.map (fun (a:Network.Interface_address.t) ->
  2121. encode_obj [
  2122. key_name, encode_string a.name;
  2123. key_isInternal, vbool a.is_internal;
  2124. key_physical, vnative_string a.physical;
  2125. key_address, encode_sockaddr a.address;
  2126. key_netmask, encode_sockaddr a.netmask;
  2127. ]
  2128. ) addresses)
  2129. ) (Network.interface_addresses())
  2130. );
  2131. "ifIndexToName", vfun1 (fun v ->
  2132. let index = decode_int v in
  2133. encode_result encode_string (Network.if_indextoname index)
  2134. );
  2135. "ifIndexToIid", vfun1 (fun v ->
  2136. let index = decode_int v in
  2137. encode_result encode_string (Network.if_indextoiid index)
  2138. );
  2139. "getHostName", vfun0 (fun() ->
  2140. encode_result encode_string (Network.gethostname())
  2141. );
  2142. ]
  2143. let fs_poll_fields = [
  2144. "init", vfun1 (fun v ->
  2145. let loop = decode_loop v in
  2146. encode_result (fun p -> VHandle (HFsPoll p)) (FS_poll.init ~loop ())
  2147. );
  2148. "start", vfun4 (fun v1 v2 v3 v4 ->
  2149. let poll = decode_fs_poll v1
  2150. and path = decode_native_string v2
  2151. and interval = decode_optional decode_int v3
  2152. and callback =
  2153. encode_callback (fun (previous,current) ->
  2154. encode_obj [
  2155. key_previous,encode_file_stat previous;
  2156. key_current,encode_file_stat current;
  2157. ]
  2158. ) v4
  2159. in
  2160. FS_poll.start ?interval poll path callback;
  2161. vnull
  2162. );
  2163. "stop", vfun1 (fun v ->
  2164. let poll = decode_fs_poll v in
  2165. encode_unit_result (FS_poll.stop poll)
  2166. );
  2167. ]
  2168. let resource_fields = [
  2169. "uptime", vfun0 (fun() ->
  2170. encode_result vfloat (Resource.uptime());
  2171. );
  2172. "loadAvg", vfun0 (fun() ->
  2173. let m1,m5,m15 = Resource.loadavg() in
  2174. encode_array_a [|vfloat m1; vfloat m5; vfloat m15|];
  2175. );
  2176. "freeMemory", vfun0 (fun() ->
  2177. VUInt64 (Resource.free_memory())
  2178. );
  2179. "totalMemory", vfun0 (fun() ->
  2180. VUInt64 (Resource.total_memory())
  2181. );
  2182. "constrainedMemory", vfun0 (fun() ->
  2183. encode_nullable (fun u -> VUInt64 u) (Resource.constrained_memory())
  2184. );
  2185. "getPriority", vfun1 (fun v ->
  2186. let pid = decode_int v in
  2187. encode_result vint (Resource.getpriority pid)
  2188. );
  2189. "setPriority", vfun2 (fun v1 v2 ->
  2190. let pid = decode_int v1
  2191. and priority = decode_int v2 in
  2192. encode_unit_result (Resource.setpriority pid priority)
  2193. );
  2194. "residentSetMemory", vfun0 (fun() ->
  2195. encode_result encode_size_t (Resource.resident_set_memory())
  2196. );
  2197. "getRUsage", vfun0 (fun() ->
  2198. let encode_timeval (t:Resource.timeval) =
  2199. encode_obj [
  2200. key_sec, VInt64 (Signed.Long.to_int64 t.sec);
  2201. key_usec, VInt64 (Signed.Long.to_int64 t.usec)
  2202. ]
  2203. in
  2204. let encode_rusage (r:Resource.rusage) =
  2205. encode_obj_s [
  2206. "utime", encode_timeval r.utime;
  2207. "stime", encode_timeval r.stime;
  2208. "maxrss", VUInt64 r.maxrss;
  2209. "ixrss", VUInt64 r.ixrss;
  2210. "idrss", VUInt64 r.idrss;
  2211. "isrss", VUInt64 r.isrss;
  2212. "minflt", VUInt64 r.minflt;
  2213. "majflt", VUInt64 r.majflt;
  2214. "nswap", VUInt64 r.nswap;
  2215. "inblock", VUInt64 r.inblock;
  2216. "oublock", VUInt64 r.oublock;
  2217. "msgsnd", VUInt64 r.msgsnd;
  2218. "msgrcv", VUInt64 r.msgrcv;
  2219. "nsignals", VUInt64 r.nsignals;
  2220. "nvcsw", VUInt64 r.nvcsw;
  2221. "nivcsw", VUInt64 r.nivcsw;
  2222. ]
  2223. in
  2224. encode_result encode_rusage (Resource.getrusage())
  2225. );
  2226. ]
  2227. let system_info_fields = [
  2228. "cpuInfo", vfun0 (fun() ->
  2229. let encode_info (i:System_info.CPU_info.t) =
  2230. encode_obj_s [
  2231. "model", encode_string i.model;
  2232. "speed", vint i.speed;
  2233. "times", encode_obj_s [
  2234. "user", VUInt64 i.times.user;
  2235. "nice", VUInt64 i.times.nice;
  2236. "sys", VUInt64 i.times.sys;
  2237. "idle", VUInt64 i.times.idle;
  2238. "irq", VUInt64 i.times.irq;
  2239. ]
  2240. ]
  2241. in
  2242. let encode l =
  2243. encode_array (List.map encode_info l)
  2244. in
  2245. encode_result encode (System_info.cpu_info());
  2246. );
  2247. "uname", vfun0 (fun() ->
  2248. encode_result (fun (u:System_info.Uname.t) ->
  2249. encode_obj_s [
  2250. "sysname", encode_string u.sysname;
  2251. "release", encode_string u.release;
  2252. "version", encode_string u.version;
  2253. "machine", encode_string u.machine;
  2254. ]
  2255. ) (System_info.uname())
  2256. );
  2257. ]
  2258. let pid_fields = [
  2259. "getPid", vfun0 (fun() ->
  2260. vint (Pid.getpid())
  2261. );
  2262. "getPPid", vfun0 (fun() ->
  2263. vint (Pid.getppid())
  2264. );
  2265. ]
  2266. let passwd_fields = [
  2267. "getPasswd", vfun0 (fun() ->
  2268. encode_result (fun (p:Passwd.t) ->
  2269. encode_obj_s [
  2270. "username",encode_string p.username;
  2271. "uid",vint p.uid;
  2272. "gid",vint p.gid;
  2273. "shell",encode_nullable encode_string p.shell;
  2274. "homedir",vnative_string p.homedir;
  2275. ]
  2276. ) (Passwd.get_passwd())
  2277. );
  2278. ]
  2279. let metrics_fields = [
  2280. "idleTime", vfun1 (fun v ->
  2281. let loop = decode_loop v in
  2282. VUInt64 (Metrics.idle_time loop)
  2283. );
  2284. ]
  2285. let prepare_fields = [
  2286. "init", vfun1 (fun v ->
  2287. let loop = decode_loop v in
  2288. encode_result (fun i -> VHandle (HPrepare i)) (Prepare.init ~loop ())
  2289. );
  2290. "start", vfun2 (fun v1 v2 ->
  2291. let prepare = decode_prepare v1 in
  2292. let cb = prepare_callback v2 0 in
  2293. encode_unit_result (Prepare.start prepare (fun() -> ignore(cb [])));
  2294. );
  2295. "stop", vfun1 (fun v ->
  2296. let prepare = decode_prepare v in
  2297. encode_unit_result (Prepare.stop prepare)
  2298. );
  2299. ]
  2300. let check_fields = [
  2301. "init", vfun1 (fun v ->
  2302. let loop = decode_loop v in
  2303. encode_result (fun i -> VHandle (HCheck i)) (Check.init ~loop ())
  2304. );
  2305. "start", vfun2 (fun v1 v2 ->
  2306. let check = decode_check v1 in
  2307. let cb = prepare_callback v2 0 in
  2308. encode_unit_result (Check.start check (fun() -> ignore(cb [])));
  2309. );
  2310. "stop", vfun1 (fun v ->
  2311. let check = decode_check v in
  2312. encode_unit_result (Check.stop check)
  2313. );
  2314. ]
  2315. let version_fields = [
  2316. "string", vfun0 (fun() -> encode_string (Version.string()));
  2317. "major", vint (Version.major);
  2318. "minor", vint (Version.minor);
  2319. "patch", vint (Version.patch);
  2320. "isRelease", vbool (Version.is_release);
  2321. "suffix", encode_string (Version.suffix);
  2322. "hex", vint (Version.hex);
  2323. ]