Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file linux_ext.ml
12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112open!CoremoduleFile_descr=Unix.File_descrmoduleSyscall_result=Unix.Syscall_resultmoduleSysinfo0=structtypet={uptime:Time.Span.t;load1:int;load5:int;load15:int;total_ram:int;free_ram:int;shared_ram:int;buffer_ram:int;total_swap:int;free_swap:int;procs:int;totalhigh:int;freehigh:int;mem_unit:int;}[@@derivingbin_io,sexp]end(* If you update this type, you also must update linux_tcpopt_bool, in the C stubs. (And
do make sure you get the order correct) *)typetcp_bool_option=TCP_CORK|TCP_QUICKACK[@@derivingsexp,bin_io]moduleBound_to_interface=structtypet=Any|Onlyofstring[@@derivingsexp_of]end(* We use [Int63] rather than [Int] because these flags use 32 bits. *)moduleEpoll_flags(Flag_values:sigvalin_:Int63.tvalout:Int63.t(* val rdhup : Int63.t *)valpri:Int63.tvalerr:Int63.tvalhup:Int63.tvalet:Int63.tvaloneshot:Int63.tend)=structletnone=Int63.zeroincludeFlag_valuesincludeFlags.Make(structletallow_intersecting=falseletshould_print_error=trueletremove_zero_flags=falseletknown=[in_,"in";out,"out";(* rdhup, "rdhup"; *)pri,"pri";err,"err";hup,"hup";et,"et";oneshot,"oneshot";];;end)endmodulePriority:sigtypet[@@derivingsexp]valequal:t->t->boolvalof_int:int->tvalto_int:t->intvalincr:t->tvaldecr:t->tend=structtypet=int[@@derivingsexp]letof_intt=tletto_intt=tletincrt=t-1letdecrt=t+1letequal(t:t)t'=t=t'endmodulePeer_credentials=struct(* C code depends on the layout of the type *)typet={pid:Pid.t;uid:int;gid:int}[@@derivingsexp_of]end(* These module contains definitions that get used when the necessary features are not
enabled. We put these somewhere where they'll always be compiled, to prevent them from
getting out of sync with the real implementations. *)moduleNull_toplevel=structmoduleSysinfo=structincludeSysinfo0letsysinfo=Or_error.unimplemented"Linux_ext.Sysinfo.sysinfo"endletu=Or_error.unimplementedletcores=u"Linux_ext.cores"letfile_descr_realpath=u"Linux_ext.file_descr_realpath"letget_ipv4_address_for_interface=u"Linux_ext.get_ipv4_address_for_interface"letbind_to_interface=u"Linux_ext.bind_to_interface"letget_bind_to_interface=u"Linux_ext.get_bind_to_interface"letget_terminal_size=u"Linux_ext.get_terminal_size"letgettcpopt_bool=u"Linux_ext.gettcpopt_bool"letsetpriority=u"Linux_ext.setpriority"letgetpriority=u"Linux_ext.getpriority"letin_channel_realpath=u"Linux_ext.in_channel_realpath"letout_channel_realpath=u"Linux_ext.out_channel_realpath"letpr_get_name=u"Linux_ext.pr_get_name"letpr_get_pdeathsig=u"Linux_ext.pr_get_pdeathsig"letpr_set_name_first16=u"Linux_ext.pr_set_name_first16"letpr_set_pdeathsig=u"Linux_ext.pr_set_pdeathsig"letsched_setaffinity=u"Linux_ext.sched_setaffinity"letsched_getaffinity=u"Linux_ext.sched_getaffinity"letsched_setaffinity_this_thread=u"Linux_ext.sched_setaffinity_this_thread"letsend_no_sigpipe=u"Linux_ext.send_no_sigpipe"letsend_nonblocking_no_sigpipe=u"Linux_ext.send_nonblocking_no_sigpipe"letsendfile=u"Linux_ext.sendfile"letsendmsg_nonblocking_no_sigpipe=u"Linux_ext.sendmsg_nonblocking_no_sigpipe"letsettcpopt_bool=u"Linux_ext.settcpopt_bool"letpeer_credentials=u"Linux_ext.peer_credentials"moduleEpoll=structmoduleFlags=Epoll_flags(structletin_=Int63.of_int(1lsl0)letout=Int63.of_int(1lsl1)(* let rdhup = Int63.of_int (1 lsl 2) *)letpri=Int63.of_int(1lsl3)leterr=Int63.of_int(1lsl4)lethup=Int63.of_int(1lsl5)letet=Int63.of_int(1lsl6)letoneshot=Int63.of_int(1lsl7)end)typet=[`Epoll_is_not_implemented][@@derivingsexp_of]letcreate=Or_error.unimplemented"Linux_ext.Epoll.create"letclose_=assertfalseletinvariant_=assertfalseletfind__=assertfalseletfind_exn__=assertfalseletset___=assertfalseletremove__=assertfalseletiter_~f:_=assertfalseletwait_~timeout:_=assertfalseletwait_timeout_after__=assertfalseletiter_ready_~f:_=assertfalseletfold_ready_~init:_~f:_=assertfalsemoduleExpert=structletclear_ready_=assertfalseend(* let pwait _ ~timeout:_ _ = assert false *)endendmoduleNull:Linux_ext_intf.S=structtypenonrectcp_bool_option=tcp_bool_option=TCP_CORK|TCP_QUICKACK[@@derivingsexp,bin_io]moduleBound_to_interface=structtypet=Bound_to_interface.t=Any|Onlyofstring[@@derivingsexp_of]endmodulePeer_credentials=Peer_credentialsmodulePriority=PrioritymoduleClock=structtypetletget=Or_error.unimplemented"Linux_ext.Clock.get"letget_time=Or_error.unimplemented"Linux_ext.Clock.get_time"letset_time=Or_error.unimplemented"Linux_ext.Clock.set_time"letget_resolution=Or_error.unimplemented"Linux_ext.Clock.get_resolution"letget_process_clock=Or_error.unimplemented"Linux_ext.Clock.get_process_clock"letget_thread_clock=Or_error.unimplemented"Linux_ext.Clock.get_thread_clock"endmoduleEventfd=structtypet=File_descr.t[@@derivingcompare,sexp_of]moduleFlags=struct(* These (and flags below) are in octal to match the system header file
<bits/eventfd.h> *)letnonblock=Int63.of_int0o4000letcloexec=Int63.of_int0o2000000letsemaphore=Int63.of_int0o1includeFlags.Make(structletallow_intersecting=trueletshould_print_error=trueletremove_zero_flags=falseletknown=[nonblock,"nonblock";cloexec,"cloexec";semaphore,"semaphore"]end)endletcreate=Or_error.unimplemented"Linux_ext.Eventfd.create"letread_=assertfalseletwrite_=assertfalseletto_file_descrt=tendmoduleTimerfd=structmoduleClock=structtypet=unit[@@derivingbin_io,compare,sexp]letrealtime=()letmonotonic=()endmoduleFlags=structletnonblock=Int63.of_int0o4000letcloexec=Int63.of_int0o2000000includeFlags.Make(structletallow_intersecting=falseletshould_print_error=trueletremove_zero_flags=falseletknown=List.rev[nonblock,"nonblock";cloexec,"cloexec";]end)endtypet=File_descr.t[@@derivingcompare,sexp_of]letto_file_descrt=ttyperepeat={fire_after:Time_ns.Span.t;interval:Time_ns.Span.t}letcreate=Or_error.unimplemented"Linux_ext.Timerfd.create"letset_at__=assertfalseletset_after__=assertfalseletset_repeating?after:___=assertfalseletclear_=assertfalseletget_=assertfalsemodulePrivate=structletunsafe_timerfd_settime_=assertfalseendendmoduleExtended_file_attributes=structmoduleGet_attr_result=structtypet=|Okofstring|ENOATTR|ERANGE|ENOTSUP[@@derivingsexp_of]endletgetxattr=Or_error.unimplemented"Linux_ext.Extended_file_attributes.getxattr"moduleSet_attr_result=structtypet=|Ok|EEXIST|ENOATTR|ENOTSUP[@@derivingsexp_of]endletsetxattr=Or_error.unimplemented"Linux_ext.Extended_file_attributes.setxattr"endincludeNull_toplevelend[%%import"config.h"][%%ifdefJSC_POSIX_TIMERS]moduleClock=structtypet(* These functions should be in Unix, but due to the dependency on Time,
this is not possible (cyclic dependency). *)externalget_time:t->float="core_unix_clock_gettime"letget_timet=Time.Span.of_sec(get_timet)externalset_time:t->float->unit="core_unix_clock_settime"letset_timets=set_timet(Time.Span.to_secs)externalget_resolution:t->float="core_unix_clock_getres"letget_resolutiont=Time.Span.of_sec(get_resolutiont)externalget_process_clock:unit->t="core_unix_clock_process_cputime_id_stub"externalget_thread_clock:unit->t="core_unix_clock_thread_cputime_id_stub"[%%ifdefJSC_THREAD_CPUTIME]externalget:Thread.t->t="core_unix_pthread_getcpuclockid"letget=Okget[%%else]letget=Or_error.unimplemented"Linux_ext.Clock.get"[%%endif]letget_time=Okget_timeletset_time=Okset_timeletget_resolution=Okget_resolutionletget_process_clock=Okget_process_clockletget_thread_clock=Okget_thread_clockend[%%else]moduleClock=Null.Clock[%%endif][%%ifdefJSC_TIMERFD]moduleTimerfd=structmoduleClock:sigtypet[@@derivingbin_io,compare,sexp]valrealtime:tvalmonotonic:tend=structtypet=Int63.t[@@derivingbin_io,compare,sexp]externalrealtime:unit->Int63.t="core_linux_timerfd_CLOCK_REALTIME"letrealtime=realtime()externalmonotonic:unit->Int63.t="core_linux_timerfd_CLOCK_MONOTONIC"letmonotonic=monotonic()endmoduleFlags=structexternalnonblock:unit->Int63.t="core_linux_timerfd_TFD_NONBLOCK"letnonblock=nonblock()externalcloexec:unit->Int63.t="core_linux_timerfd_TFD_CLOEXEC"letcloexec=cloexec()includeFlags.Make(structletallow_intersecting=falseletshould_print_error=trueletremove_zero_flags=falseletknown=List.rev[nonblock,"nonblock";cloexec,"cloexec";]end)endtypet=File_descr.t[@@derivingcompare,sexp_of]letto_file_descrt=texternaltimerfd_create:Clock.t->Flags.t->int="core_linux_timerfd_create"(* At Jane Street, we link with [--wrap timerfd_create] so that we can use
our own wrapper around [timerfd_create]. This allows us to compile an executable on
a machine that has timerfd (e.g. CentOS 6) but then run the executable on a machine
that does not (e.g. CentOS 5), but that has our wrapper library. We set up our
wrapper so that when running on a machine that doesn't have it, [timerfd_create]
raises ENOSYS. *)letcreate=letcreate?(flags=Flags.empty)clock=File_descr.of_int(timerfd_createclockflags)inmatchResult.try_with(fun()->createClock.realtime)with|Okt->(Unix.closet;Okcreate)|Error(Unix.Unix_error(ENOSYS,_,_))->Or_error.unimplemented"Linux_ext.Timerfd.create"|Error_->(* [timerfd_create] is implemented but fails with the arguments we used above.
[create] might still be usable with different arguments, so we expose it
here. *)Okcreate;;externalunsafe_timerfd_settime:t->bool->initial:Int63.t->interval:Int63.t->Syscall_result.Unit.t="core_linux_timerfd_settime"[@@noalloc]lettimerfd_settimet~absolute~initial~interval=(* We could accept [interval < 0] or [initial < 0 when absolute], but then the
conversions to timespecs in the C code become tedious and [timerfd_setttime] fails
when it gets anything negative anyway. *)ifInt63.O.(initial<zero||interval<zero)thenraise_s[%sexp"timerfd_settime got invalid parameters (initial < 0 or interval < 0).",{timerfd=(t:t);initial=(initial:Int63.t);interval=(interval:Int63.t)}];unsafe_timerfd_settimetabsolute~initial~interval|>Syscall_result.Unit.ok_or_unix_error_exn~syscall_name:"timerfd_settime";;letinitial_of_spanspan=Time_ns.Span.to_int63_ns(ifTime_ns.Span.(<=)spanTime_ns.Span.zerothenTime_ns.Span.nanosecondelsespan);;letset_attat=ifTime_ns.(<=)atTime_ns.epochthenfailwiths~here:[%here]"Timerfd.set_at got time before epoch"at[%sexp_of:Time_ns.t];timerfd_settimet~absolute:true~initial:(Time_ns.to_int63_ns_since_epochat)~interval:Int63.zeroletset_aftertspan=timerfd_settimet~absolute:false~initial:(initial_of_spanspan)~interval:Int63.zero;;letset_repeating?aftertinterval=ifTime_ns.Span.(<=)intervalTime_ns.Span.zerothenfailwiths~here:[%here]"Timerfd.set_repeating got invalid interval"interval[%sexp_of:Time_ns.Span.t];letinterval=Time_ns.Span.to_int63_nsintervalintimerfd_settimet~absolute:false~initial:(Option.value_mapafter~f:initial_of_span~default:interval)~interval;;letcleart=timerfd_settimet~absolute:false~initial:Int63.zero~interval:Int63.zerotyperepeat={fire_after:Time_ns.Span.t;interval:Time_ns.Span.t}externaltimerfd_gettime:t->repeat="core_linux_timerfd_gettime"letgett=letspec=timerfd_gettimetinifTime_ns.Span.equalspec.intervalTime_ns.Span.zerothenifTime_ns.Span.equalspec.fire_afterTime_ns.Span.zerothen`Not_armedelse`Fire_afterspec.fire_afterelse`Repeatspec;;modulePrivate=structletunsafe_timerfd_settime=unsafe_timerfd_settimeendend[%%else]moduleTimerfd=Null.Timerfd[%%endif][%%ifdefJSC_LINUX_EXT]typefile_descr=Unix.File_descr.tmoduleEventfd=structmoduleFlags=structexternalcloexec:unit->Int63.t="core_linux_eventfd_EFD_CLOEXEC"externalnonblock:unit->Int63.t="core_linux_eventfd_EFD_NONBLOCK"externalsemaphore:unit->Int63.t="core_linux_eventfd_EFD_SEMAPHORE"letcloexec=cloexec()letnonblock=nonblock()letsemaphore=semaphore()letknown=[cloexec,"cloexec";nonblock,"nonblock";semaphore,"semaphore"]includeFlags.Make(structletallow_intersecting=trueletshould_print_error=trueletknown=knownletremove_zero_flags=falseend)endtypet=File_descr.t[@@derivingcompare,sexp_of]externalcreate:Int32.t->Flags.t->t="core_linux_eventfd"externalread:t->Int64.t="core_linux_eventfd_read"externalwrite:t->Int64.t->unit="core_linux_eventfd_write"letcreate=letcreate?(flags=Flags.empty)init=createinitflagsinOr_error.returncreateletto_file_descrt=tendexternalsendfile:sock:file_descr->fd:file_descr->pos:int->len:int->int="core_linux_sendfile_stub";;letsendfile?(pos=0)?len~fdsock=letlen=matchlenwith|Somelen->len|None->Int64.to_int_exn(Int64.(-)(Unix.fstatfd).st_size(Int64.of_intpos))insendfile~sock~fd~pos~len(* Raw result of sysinfo syscall *)moduleRaw_sysinfo=structtypet={uptime:int;load1:int;load5:int;load15:int;total_ram:int;free_ram:int;shared_ram:int;buffer_ram:int;total_swap:int;free_swap:int;procs:int;totalhigh:int;freehigh:int;mem_unit:int;}endmoduleSysinfo=structincludeSysinfo0externalraw_sysinfo:unit->Raw_sysinfo.t="core_linux_sysinfo"letsysinfo=Ok(fun()->letraw=raw_sysinfo()in{uptime=Time.Span.of_int_secraw.Raw_sysinfo.uptime;load1=raw.Raw_sysinfo.load1;load5=raw.Raw_sysinfo.load5;load15=raw.Raw_sysinfo.load15;total_ram=raw.Raw_sysinfo.total_ram;free_ram=raw.Raw_sysinfo.free_ram;shared_ram=raw.Raw_sysinfo.shared_ram;buffer_ram=raw.Raw_sysinfo.buffer_ram;total_swap=raw.Raw_sysinfo.total_swap;free_swap=raw.Raw_sysinfo.free_swap;procs=raw.Raw_sysinfo.procs;totalhigh=raw.Raw_sysinfo.totalhigh;freehigh=raw.Raw_sysinfo.freehigh;mem_unit=raw.Raw_sysinfo.mem_unit;})endexternalgettcpopt_bool:file_descr->tcp_bool_option->bool="core_linux_gettcpopt_bool_stub"externalsettcpopt_bool:file_descr->tcp_bool_option->bool->unit="core_linux_settcpopt_bool_stub"externalpeer_credentials:file_descr->Peer_credentials.t="core_linux_peer_credentials"externalunsafe_send_nonblocking_no_sigpipe:file_descr->pos:int->len:int->Bytes.t->int="core_linux_send_nonblocking_no_sigpipe_stub"letunsafe_send_nonblocking_no_sigpipefd~pos~lenbuf=letres=unsafe_send_nonblocking_no_sigpipefd~pos~lenbufinifres=-1thenNoneelseSomeresexternalunsafe_send_no_sigpipe:file_descr->pos:int->len:int->Bytes.t->int="core_linux_send_no_sigpipe_stub"letcheck_send_args?pos?lenbuf=letstr_len=Bytes.lengthbufinletpos=matchposwith|None->0|Somepos->ifpos<0theninvalid_arg"send_nonblocking_no_sigpipe: pos < 0";ifpos>str_lentheninvalid_arg"send_nonblocking_no_sigpipe: pos > str_len";posinletlen=matchlenwith|None->str_len-pos|Somelen->iflen<0theninvalid_arg"send_nonblocking_no_sigpipe: pos < 0";ifpos+len>str_lentheninvalid_arg"send_nonblocking_no_sigpipe: pos + len > str_len";lenin(pos,len)letsend_nonblocking_no_sigpipesock?pos?lenbuf=let(pos,len)=check_send_args?pos?lenbufinunsafe_send_nonblocking_no_sigpipesock~pos~lenbufletsend_no_sigpipesock?pos?lenbuf=let(pos,len)=check_send_args?pos?lenbufinunsafe_send_no_sigpipesock~pos~lenbufexternalunsafe_sendmsg_nonblocking_no_sigpipe:file_descr->stringUnix.IOVec.tarray->int->int="core_linux_sendmsg_nonblocking_no_sigpipe_stub"letunsafe_sendmsg_nonblocking_no_sigpipefdiovecscount=letres=unsafe_sendmsg_nonblocking_no_sigpipefdiovecscountinifres=-1thenNoneelseSomeresletsendmsg_nonblocking_no_sigpipesock?countiovecs=letcount=matchcountwith|None->Array.lengthiovecs|Somecount->ifcount<0theninvalid_arg"sendmsg_nonblocking_no_sigpipe: count < 0";letn_iovecs=Array.lengthiovecsinifcount>n_iovecstheninvalid_arg"sendmsg_nonblocking_no_sigpipe: count > n_iovecs";countinunsafe_sendmsg_nonblocking_no_sigpipesockiovecscountexternalpr_set_pdeathsig:Signal.t->unit="core_linux_pr_set_pdeathsig_stub"externalpr_get_pdeathsig:unit->Signal.t="core_linux_pr_get_pdeathsig_stub"externalpr_set_name_first16:string->unit="core_linux_pr_set_name"externalpr_get_name:unit->string="core_linux_pr_get_name"letfile_descr_realpathfd=Filename.realpath("/proc/self/fd/"^File_descr.to_stringfd)letout_channel_realpathoc=file_descr_realpath(Unix.descr_of_out_channeloc)letin_channel_realpathic=file_descr_realpath(Unix.descr_of_in_channelic)externalraw_sched_setaffinity:pid:int->cpuset:intlist->unit="core_linux_sched_setaffinity"letsched_setaffinity?pid~cpuset()=letpid=matchpidwithNone->0|Somepid->Pid.to_intpidinraw_sched_setaffinity~pid~cpuset;;externalraw_sched_getaffinity:pid:int->intlist="core_linux_sched_getaffinity"letsched_getaffinity?pid()=letpid=matchpidwithNone->0|Somepid->Pid.to_intpidinraw_sched_getaffinity~pid;;(* defined in unix_stubs.c *)externalgettid:unit->int="core_unix_gettid"externalsetpriority:Priority.t->unit="core_linux_setpriority"externalgetpriority:unit->Priority.t="core_linux_getpriority"letsched_setaffinity_this_thread~cpuset=sched_setaffinity~pid:(Pid.of_int(gettid()))~cpuset();;letcores=Memo.unit(fun()->letnum_cores=In_channel.with_file"/proc/cpuinfo"~f:In_channel.input_lines|>List.fold_left~init:0~f:(funcountline->count+(matchString.lsplit2~on:':'linewith|None->0|Some(label,_)->ifString.(=)(String.rstriplabel)"processor"then1else0))inifnum_cores>0thennum_coreselsefailwith"Linux_ext.cores: failed to parse /proc/cpuinfo")externalget_terminal_size:File_descr.t->int*int="core_linux_get_terminal_size"letget_terminal_size=function|`Fdfd->get_terminal_sizefd|`Controlling->protectx(Unix.openfile"/dev/tty"~mode:[O_RDWR]~perm:0)~finally:Unix.close~f:get_terminal_sizeexternalget_ipv4_address_for_interface:string->string="core_linux_get_ipv4_address_for_interface";;(* The C-stub is a simple pass-through of the linux SO_BINDTODEVICE semantics, wherein an
empty string removes any binding *)externalbind_to_interface':File_descr.t->string->unit="core_linux_bind_to_interface";;letbind_to_interfacefdifname=letname=matchifnamewith|Bound_to_interface.Onlyname->name|Bound_to_interface.Any->""inbind_to_interface'fdname;;externalget_bind_to_interface':File_descr.t->string="core_linux_get_bind_to_interface";;letget_bind_to_interfacefd=matchget_bind_to_interface'fdwith|""->Bound_to_interface.Any|name->Bound_to_interface.OnlynamemoduleEpoll=structexternalflag_epollin:unit->Int63.t="core_linux_epoll_EPOLLIN_flag"externalflag_epollout:unit->Int63.t="core_linux_epoll_EPOLLOUT_flag"(* external flag_epollrdhup : unit -> Int63.t = "core_linux_epoll_EPOLLRDHUP_flag" *)externalflag_epollpri:unit->Int63.t="core_linux_epoll_EPOLLPRI_flag"externalflag_epollerr:unit->Int63.t="core_linux_epoll_EPOLLERR_flag"externalflag_epollhup:unit->Int63.t="core_linux_epoll_EPOLLHUP_flag"externalflag_epollet:unit->Int63.t="core_linux_epoll_EPOLLET_flag"externalflag_epolloneshot:unit->Int63.t="core_linux_epoll_EPOLLONESHOT_flag"moduleFlags=Epoll_flags(structletin_=flag_epollin()letout=flag_epollout()(* let rdhup = flag_epollrdhup () *)letpri=flag_epollpri()leterr=flag_epollerr()lethup=flag_epollhup()letet=flag_epollet()letoneshot=flag_epolloneshot()end)externalepoll_create:unit->File_descr.t="core_linux_epoll_create"(* Some justification for the below interface: Unlike select() and poll(), epoll() fills
in an array of ready events, analogous to a read() call where you pass in a buffer to
be filled.
Since this is at the core of the I/O loop, we'd like to avoid reallocating that
buffer on every call to poll. We're allocating the array on the ocaml side (as a
Bigstring), then iterating through it in-place, reducing allocation, copies, and any
intermediate lists. For very high message rates and many fds this could be a very
beneficial. *)typeready_events=Bigstring.texternalepoll_sizeof_epoll_event:unit->int="core_linux_epoll_sizeof_epoll_event"[@@noalloc]externalepoll_offsetof_readyfd:unit->int="core_linux_epoll_offsetof_readyfd"[@@noalloc]externalepoll_offsetof_readyflags:unit->int="core_linux_epoll_offsetof_readyflags"[@@noalloc]letsizeof_epoll_event=epoll_sizeof_epoll_event()letoffsetof_readyfd=epoll_offsetof_readyfd()letoffsetof_readyflags=epoll_offsetof_readyflags()externalepoll_ctl_add:File_descr.t->File_descr.t->Flags.t->unit="core_linux_epoll_ctl_add"externalepoll_ctl_mod:File_descr.t->File_descr.t->Flags.t->unit="core_linux_epoll_ctl_mod"externalepoll_ctl_del:File_descr.t->File_descr.t->unit="core_linux_epoll_ctl_del"moduleTable=Bounded_int_tablemoduleT=structtype'at={epollfd:File_descr.t;(* [flags_by_fd] has one entry for each file-descr in the epoll set, and stores
the epoll flags that the kernel's epoll set currently has for that
file-descr. Keeping our own representation of the kernel data structure is
useful for debugging, since the information appears in a human-readable way
in [sexp_of_t]'s output. It also allows us to hide the distinction between
[epoll_ctl_add] and [epoll_ctl_mod], since we know which to use based on
whether the file descriptor is already being watched. *)flags_by_fd:(File_descr.t,Flags.t)Table.t;max_ready_events:int;(* [num_ready_events] holds the number of ready events in [ready_events], as
determined by the last call to [wait]. *)mutablenum_ready_events:int;ready_events:'a;}[@@derivingfields,sexp_of]endopenTletepoll_readyfdti=Bigstring.unsafe_get_int32_let~pos:(i*sizeof_epoll_event+offsetof_readyfd)|>File_descr.of_int;;letepoll_readyflagsti=Bigstring.unsafe_get_int32_let~pos:(i*sizeof_epoll_event+offsetof_readyflags)|>Flags.of_int;;typein_use=ready_eventsT.tmodulePretty=structtypeready_event={file_descr:File_descr.t;flags:Flags.t;}[@@derivingsexp_of]typeready_events=ready_eventarray[@@derivingsexp_of]typet=ready_eventsT.t[@@derivingsexp_of]endletto_prettyt={twithready_events=Array.initt.num_ready_events~f:(funi->{Pretty.file_descr=epoll_readyfdt.ready_eventsi;flags=epoll_readyflagst.ready_eventsi;});};;letsexp_of_in_uset=Pretty.sexp_of_t(to_prettyt)typet=[`Closed|`In_useofin_use]ref[@@derivingsexp_of]letcloset=match!twith|`Closed->()|`In_use{epollfd;_}->t:=`Closed;Unix.closeepollfd;;;letinvariantt:unit=match!twith|`Closed->()|`In_uset->tryletcheckffield=f(Field.getfieldt)inFields.iter~epollfd:ignore~flags_by_fd:(check(Table.invariantignoreignore))~max_ready_events:(check(funmax_ready_events->assert(max_ready_events>0)))~num_ready_events:(check(funnum_ready->assert(num_ready>=0)))~ready_events:ignorewithexn->failwiths~here:[%here]"Epoll.invariant failed"(exn,t)[%sexp_of:exn*in_use];;letcreate~num_file_descrs~max_ready_events=ifmax_ready_events<0thenfailwiths~here:[%here]"Epoll.create got nonpositive max_ready_events"max_ready_events([%sexp_of:int]);ref(`In_use{epollfd=epoll_create();flags_by_fd=Table.create~num_keys:num_file_descrs~key_to_int:File_descr.to_int~sexp_of_key:File_descr.sexp_of_t();max_ready_events;num_ready_events=0;ready_events=Bigstring.create(sizeof_epoll_event*max_ready_events);});;letin_use_exnt=match!twith|`Closed->failwith"attempt to use closed epoll set"|`In_user->r;;letfindtfile_descr=lett=in_use_exntinTable.findt.flags_by_fdfile_descr;;letfind_exntfile_descr=lett=in_use_exntinTable.find_exnt.flags_by_fdfile_descr;;letitert~f=lett=in_use_exntinTable.iterit.flags_by_fd~f:(fun~key:file_descr~data:flags->ffile_descrflags);;letsettfdflags=lett=in_use_exntinletalready_present=Table.memt.flags_by_fdfdinTable.sett.flags_by_fd~key:fd~data:flags;ifalready_presentthenepoll_ctl_modt.epollfdfdflagselseepoll_ctl_addt.epollfdfdflags;;letremovetfd=lett=in_use_exntinifTable.memt.flags_by_fdfdthenepoll_ctl_delt.epollfdfd;Table.removet.flags_by_fdfd;;externalepoll_wait:File_descr.t->ready_events->int->int="core_linux_epoll_wait"letwait_internalt~timeout_ms=lett=in_use_exntin(* We clear [num_ready_events] because [epoll_wait] will invalidate [ready_events],
and we don't want another thread to observe [t] and see junk. *)t.num_ready_events<-0;t.num_ready_events<-epoll_waitt.epollfdt.ready_eventstimeout_ms;ift.num_ready_events=0then`Timeoutelse`Ok;;letwait_timeout_aftertspan=lettimeout_ms=ifTime_ns.Span.(<=)spanTime_ns.Span.zerothen0else(* For positive timeouts, we use a minimum timeout of one millisecond, to ensure
that we are guaranteed that the timeout has passed when we wake up. If we
allowed a positive sub-millisecond timeout, we would round down and end up
using a timeout of zero, causing [wait_internal] to return immediately. Such
behaviour has been seen to cause Async to spin, repeatedly requesting slightly
smaller timeouts. *)letspan=Time_ns.Span.maxspanTime_ns.Span.millisecondinInt63.to_int_exnTime_ns.Span.(div(span+of_int63_ns(Int63.of_int500_000))(of_int63_ns(Int63.of_int1_000_000)))inassert(timeout_ms>=0);wait_internalt~timeout_ms;;letwaitt~timeout=(* From the epoll man page:
| Specifying a timeout of -1 makes epoll_wait() wait indefinitely, while
| specifying a timeout equal to zero makes epoll_wait() to return immediately
| even if no events are available (return code equal to zero). *)matchtimeoutwith|`Never->wait_internalt~timeout_ms:(-1)|`Immediately->wait_internalt~timeout_ms:0|`Afterspan->wait_timeout_aftertspan;;letfold_readyt~init~f=lett=in_use_exntinletac=refinitinfori=0tot.num_ready_events-1doac:=f!ac(epoll_readyfdt.ready_eventsi)(epoll_readyflagst.ready_eventsi)done;!ac;;letiter_readyt~f=lett=in_use_exntinfori=0tot.num_ready_events-1dof(epoll_readyfdt.ready_eventsi)(epoll_readyflagst.ready_eventsi)done;;moduleExpert=structletclear_readyt=lett=in_use_exntint.num_ready_events<-0;;end(* external epoll_pwait
* : File_descr.t -> Events_buffer.raw -> int -> int list -> int
* = "core_linux_epoll_pwait"
*
* let pwait t ~timeout sigs =
* let millis = Float.iround_exn ~dir:`Zero ( Span.to_ms timeout ) in
* let num_ready = epoll_pwait t.epollfd t.events millis sigs in
* if num_ready = 0 then `Timeout
* else `Ok { Ready_fds.num_ready ; events = t.events }
* ;; *)letcreate=Okcreateendletcores=Okcoresletfile_descr_realpath=Okfile_descr_realpathletget_ipv4_address_for_interface=Okget_ipv4_address_for_interfaceletbind_to_interface=Okbind_to_interfaceletget_bind_to_interface=Okget_bind_to_interfaceletget_terminal_size=Okget_terminal_sizeletgettcpopt_bool=Okgettcpopt_boolletsetpriority=Oksetpriorityletgetpriority=Okgetpriorityletin_channel_realpath=Okin_channel_realpathletout_channel_realpath=Okout_channel_realpathletpr_get_name=Okpr_get_nameletpr_get_pdeathsig=Okpr_get_pdeathsigletpr_set_name_first16=Okpr_set_name_first16letpr_set_pdeathsig=Okpr_set_pdeathsigletsched_setaffinity=Oksched_setaffinityletsched_getaffinity=Oksched_getaffinityletsched_setaffinity_this_thread=Oksched_setaffinity_this_threadletsend_no_sigpipe=Oksend_no_sigpipeletsend_nonblocking_no_sigpipe=Oksend_nonblocking_no_sigpipeletsendfile=Oksendfileletsendmsg_nonblocking_no_sigpipe=Oksendmsg_nonblocking_no_sigpipeletsettcpopt_bool=Oksettcpopt_boolletpeer_credentials=Okpeer_credentialsmoduleExtended_file_attributes=structmoduleFlags=structexternalonly_create:unit->Int63.t="core_linux_xattr_XATTR_CREATE_flag"externalonly_replace:unit->Int63.t="core_linux_xattr_XATTR_REPLACE_flag"letset=Int63.zeroendmoduleGet_attr_result=structtypet=|Okofstring|ENOATTR|ERANGE|ENOTSUP[@@derivingsexp_of]endmoduleSet_attr_result=structtypet=|Ok|EEXIST|ENOATTR|ENOTSUP[@@derivingsexp_of]endexternalgetxattr:string->string->Get_attr_result.t="core_linux_getxattr"externalsetxattr:string->string->string->Int63.t->Set_attr_result.t="core_linux_setxattr"letgetxattr~path~name=getxattrpathname;;letsetxattr?(how=`Set)~path~name~value()=letflags=matchhowwith|`Set->Flags.set|`Create->Flags.only_create()|`Replace->Flags.only_replace()insetxattrpathnamevalueflags;;letgetxattr=Okgetxattrletsetxattr=Oksetxattrend[%%else]includeNull_toplevelmoduleEventfd=Null.EventfdmoduleExtended_file_attributes=Null.Extended_file_attributes[%%endif]