diff options
| author | Nicolas Roche <roche@adacore.com> | 2017-09-08 15:12:17 +0000 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2017-09-08 17:12:17 +0200 |
| commit | edcc77dbd9f95301a8be1a2f2b0d774680b46a1a (patch) | |
| tree | 4c2dd8030802ada53aad734af16a8b591a2a2e86 /gcc/ada/libgnat/g-socket.adb | |
| parent | 9f00251a8e71aa96e243cb1e95dadbdbad8ada4f (diff) | |
| download | gcc-edcc77dbd9f95301a8be1a2f2b0d774680b46a1a.zip gcc-edcc77dbd9f95301a8be1a2f2b0d774680b46a1a.tar.gz gcc-edcc77dbd9f95301a8be1a2f2b0d774680b46a1a.tar.bz2 | |
Make-lang.in, [...]: Find runtime source in libgnat/
2017-09-08 Nicolas Roche <roche@adacore.com>
* gcc-interface/Make-lang.in, gcc-interface/Makefile.in: Find runtime
source in libgnat/
* a-lfztio.ads, g-timsta.ads, g-sercom-linux.adb, s-osprim-solaris.adb,
a-inteio.ads, s-stchop-rtems.adb, s-casuti.adb, s-pack39.adb,
i-vxwork-x86.ads, a-strbou.adb, a-stzmap.adb, s-assert.adb,
a-sfecin.ads, a-cohama.adb, s-casuti.ads, a-suenco.adb, s-pack39.ads,
a-stzmap.ads, a-strbou.ads, s-stalib.adb, s-trasym.adb, g-comver.adb,
s-assert.ads, s-vector.ads, g-cgi.adb, a-cohama.ads, s-wchcnv.adb,
a-titest.adb, s-pack48.adb, a-suenco.ads, a-strunb.adb, s-stalib.ads,
s-trasym.ads, a-nudira.adb, g-comver.ads, a-nuflra.adb, g-cgi.ads,
a-chacon.adb, s-wchcnv.ads, a-excach.adb, s-pack48.ads, a-titest.ads,
a-strunb.ads, s-dwalin.adb, a-nudira.ads, a-chtgbo.adb, s-resfil.adb,
a-scteio.ads, a-nuflra.ads, g-soliop-mingw.ads, s-pack57.adb,
a-chacon.ads, s-bytswa.ads, s-pooloc.adb, g-os_lib.adb, s-dwalin.ads,
a-szuzha.adb, s-resfil.ads, a-chtgbo.ads, s-spsufi.adb, s-pack57.ads,
s-pooloc.ads, g-os_lib.ads, a-stfiha.ads, a-lcteio.ads, a-wtcoau.adb,
a-szuzha.ads, s-mmosin-unix.adb, a-stmaco.ads, s-spsufi.ads,
s-stchop-limit.ads, a-wtcoau.ads, a-exctra.adb, s-mmosin-unix.ads,
s-sequio.adb, s-conca2.adb, g-table.adb, s-imglli.adb,
a-numaux-x86.adb, a-strsea.adb, s-wchstw.adb, a-clrefi.adb,
a-wwboio.adb, a-exctra.ads, s-sequio.ads, s-conca2.ads, a-wwunio.ads,
system-linux-hppa.ads, g-table.ads, s-dimkio.ads, s-imglli.ads,
a-cofove.adb, a-numaux-x86.ads, s-wchstw.ads, a-strsea.ads,
a-clrefi.ads, a-wwboio.ads, s-stratt-xdr.adb, s-crc32.adb,
s-excmac-arm.adb, g-busora.adb, a-cofove.ads, s-osprim-unix.adb,
g-io.adb, s-pack49.adb, s-crc32.ads, s-excmac-arm.ads, a-fzteio.ads,
g-busora.ads, s-stausa.adb, system-linux-mips.ads, sequenio.ads,
g-exctra.adb, g-rewdat.adb, a-cgaaso.adb, g-io.ads, s-pack49.ads,
a-wtflau.adb, a-undesu.adb, s-stausa.ads, a-ztenau.adb, g-enutst.ads,
calendar.ads, s-pack58.adb, g-rewdat.ads, g-exctra.ads, s-ststop.adb,
a-cgaaso.ads, a-strfix.adb, a-comlin.adb, a-strunb-shared.adb,
a-wtflau.ads, a-undesu.ads, a-cbhase.adb, a-ztenau.ads, s-os_lib.adb,
a-coorse.adb, a-chlat1.ads, s-pack58.ads, s-ststop.ads, a-strfix.ads,
a-comlin.ads, a-strunb-shared.ads, a-nscefu.ads, s-valboo.adb,
directio.ads, a-chtgke.adb, a-cbhase.ads, a-wtinau.adb,
system-linux-alpha.ads, s-os_lib.ads, a-coorse.ads,
system-linux-s390.ads, s-imgwiu.adb, a-chtgop.adb, s-valboo.ads,
a-chtgke.ads, a-tienio.adb, s-conca3.adb, a-wtinau.ads,
system-darwin-ppc.ads, i-c.adb, s-expllu.adb, g-expect.adb,
g-sha256.ads, s-vallld.adb, s-imgwiu.ads, a-chtgop.ads, a-strmap.adb,
a-tienio.ads, s-conca3.ads, s-imgint.adb, i-c.ads, s-expllu.ads,
s-osprim-darwin.adb, a-cogeso.adb, g-expect.ads, a-iwteio.ads,
s-vallld.ads, a-coinho-shared.adb, g-shsh64.adb, a-strmap.ads,
g-comlin.adb, a-excpol.adb, s-imgint.ads, a-ztdeau.adb, a-cogeso.ads,
a-coinho-shared.ads, g-shsh64.ads, g-comlin.ads, a-stzsup.adb,
a-rbtgbk.adb, a-wtmoau.adb, a-ztdeau.ads, s-exnlli.adb, g-tty.adb,
g-heasor.adb, g-socthi-dummy.adb, s-llflex.ads, a-zchara.ads,
a-stzsup.ads, a-ztcstr.adb, a-rbtgbk.ads, a-sfwtio.ads, a-wtmoau.ads,
a-sulcin.adb, s-exnlli.ads, system-freebsd.ads, a-stunha.adb,
a-charac.ads, g-tty.ads, g-heasor.ads, s-exctra.adb,
g-socthi-dummy.ads, a-coboho.adb, a-ztcstr.ads, a-tideio.adb,
a-sulcin.ads, a-wrstfi.adb, g-alleve.adb, s-pack59.adb, a-ngrear.adb,
a-stboha.adb, a-stunau-shared.adb, a-stunha.ads, a-lfwtio.ads,
s-fileio.adb, s-exctra.ads, a-coboho.ads, a-ioexce.ads, a-tideio.ads,
a-ngrear.ads, a-wrstfi.ads, s-pack59.ads, g-alleve.ads, a-stboha.ads,
s-poosiz.adb, g-traceb.adb, g-rannum.adb, machcode.ads, s-purexc.ads,
s-fileio.ads, a-cfinve.adb, a-crbtgk.adb, system-solaris-x86.ads,
s-poosiz.ads, g-rannum.ads, g-traceb.ads, a-except.adb, s-conca4.adb,
a-stream.adb, a-cfinve.ads, a-crbtgk.ads, s-wchwts.adb,
system-mingw.ads, a-except.ads, s-conca4.ads, a-chzla9.ads,
s-valenu.adb, s-soflin.adb, a-stream.ads, a-cgarso.adb, s-valllu.adb,
g-crc32.adb, s-wchwts.ads, s-fatflt.ads, s-imguns.adb, s-strcom.adb,
g-decstr.adb, s-valenu.ads, s-soflin.ads, a-cgarso.ads, a-cwila1.ads,
s-valllu.ads, g-crc32.ads, s-imguns.ads, g-spipat.adb, s-valwch.adb,
s-strcom.ads, g-decstr.ads, text_io.ads, g-debuti.adb, s-stchop.adb,
g-spipat.ads, s-valwch.ads, a-string.ads, s-exnint.adb, g-awk.adb,
g-tasloc.adb, s-wwdenu.adb, s-boustr.adb, a-zchuni.adb, s-stchop.ads,
g-debuti.ads, s-stopoo.adb, system-dragonfly-x86_64.ads,
system-linux-x86.ads, s-exnint.ads, g-awk.ads, a-stzhas.adb,
g-tasloc.ads, s-wwdenu.ads, g-debpoo.adb, g-except.ads,
g-sse.ads, s-boustr.ads, a-zchuni.ads, s-bitops.adb, s-wwdwch.adb,
s-stopoo.ads, a-catizo.adb, a-stzhas.ads, a-nlcefu.ads, g-debpoo.ads,
i-vxwoio.adb, s-bitops.ads, g-io-put-vxworks.adb, s-wwdwch.ads,
g-sehamd.adb, a-ssicst.adb, a-catizo.ads, s-mmap.adb, g-string.adb,
s-traceb.adb, a-swunau.adb, s-rannum.adb, a-ticoau.adb, i-vxwoio.ads,
g-sehamd.ads, a-stwiun.adb, a-ssicst.ads, s-conca5.adb, a-ssitio.ads,
s-mmap.ads, a-zttest.adb, g-string.ads, g-sercom.adb, a-cdlili.adb,
a-swunau.ads, s-traceb.ads, s-rannum.ads, a-ticoau.ads, system-aix.ads,
a-cforma.adb, a-stwiun.ads, s-conca5.ads, s-carsi8.adb, a-zttest.ads,
g-sercom.ads, a-cdlili.ads, a-cihama.adb, g-sptain.ads, a-cforma.ads,
s-maccod.ads, s-carsi8.ads, a-strsup.adb, g-sha1.adb, a-cihama.ads,
g-stseme.adb, s-traent.adb, s-valcha.adb, g-curexc.ads, a-strsup.ads,
g-sha1.ads, a-sflcin.ads, s-traent.ads, s-pack10.adb, s-valcha.ads,
a-coteio.ads, s-tasloc.adb, g-utf_32.adb, a-suteio.adb, s-except.adb,
a-direct.adb, g-stsifd-sockets.adb, a-numaux-vxworks.ads, s-winext.ads,
s-pack10.ads, a-ztexio.adb, a-tiflau.adb, system-vxworks-arm.ads,
s-tasloc.ads, a-suteio.ads, g-utf_32.ads, s-except.ads,
a-direct.ads, a-swbwha.adb, g-hesorg.adb, s-wwdcha.adb, a-wtedit.adb,
a-ztexio.ads, a-wtcoio.adb, a-tiflau.ads, a-ssizti.ads, s-casi32.adb,
a-swbwha.ads, s-veboop.adb, g-hesorg.ads, s-parame-rtems.adb,
s-wwdcha.ads, a-wtedit.ads, a-stuten.adb, a-coinve.adb, a-wtcoio.ads,
s-casi32.ads, s-string.adb, a-tiinau.adb, a-cusyqu.adb, s-conca6.adb,
s-veboop.ads, a-cgcaso.adb, a-numaux-darwin.adb, a-envvar.adb,
a-stuten.ads, s-secsta.adb, a-coinve.ads, s-string.ads, a-cusyqu.ads,
a-tiinau.ads, s-osprim-vxworks.adb, s-conca6.ads, g-spchge.adb,
s-parint.adb, a-cuprqu.adb, a-cgcaso.ads, a-numaux-darwin.ads,
a-envvar.ads, s-secsta.ads, g-spchge.ads, s-parint.ads, a-cuprqu.ads,
a-swuwti.adb, a-flteio.ads, a-sbhcin.adb, a-coprnu.adb, g-u3spch.adb,
s-atocou.adb, g-ctrl_c.adb, a-swuwti.ads, a-calend.adb, a-sbhcin.ads,
a-coprnu.ads, g-dirope.adb, g-sha512.ads, g-u3spch.ads, s-atocou.ads,
g-ctrl_c.ads, a-timoau.adb, a-witeio.adb, s-pack11.adb, a-strhas.adb,
a-wtflio.adb, g-spitbo.adb, a-calend.ads, a-ztenio.adb, g-dirope.ads,
a-slcain.adb, g-sechas.adb, a-timoau.ads, a-witeio.ads, s-pack11.ads,
s-shasto.adb, s-traceb-mastop.adb, a-ciorse.adb, s-utf_32.adb,
a-strhas.ads, a-wtflio.ads, g-spitbo.ads, a-ztenio.ads, a-slcain.ads,
g-sechas.ads, s-gearop.adb, a-siztio.ads, s-pack20.adb, s-shasto.ads,
a-ciorse.ads, s-utf_32.ads, s-crtl.ads, a-wtinio.adb, s-elaall.adb,
s-explli.adb, s-chepoo.ads, s-gearop.ads, a-einuoc.adb, s-pack20.ads,
system-linux-ia64.ads, a-swunau-shared.adb, a-wtinio.ads, g-alvety.ads,
a-liztio.ads, g-calend.adb, s-conca7.adb, s-elaall.ads, s-explli.ads,
a-einuoc.ads, s-widboo.adb, s-imgdec.adb, a-cbhama.adb, g-calend.ads,
s-conca7.ads, a-llitio.ads, i-cexten.ads, a-coorma.adb, s-widboo.ads,
s-diflio.adb, g-souinf.ads, s-imgdec.ads, g-strhas.ads, a-cbhama.ads,
g-shshco.adb, a-ztdeio.adb, s-gloloc.adb, a-coorma.ads, g-wispch.adb,
s-pack03.adb, g-eacodu.adb, s-casi16.adb, s-diflio.ads, a-colien.adb,
g-shshco.ads, a-wtmoio.adb, a-rbtgbo.adb, a-ztdeio.ads,
system-rtems.ads, s-gloloc.ads, a-csquin.ads, a-cofuse.adb,
g-wispch.ads, s-pack03.ads, s-casi16.ads, s-io.adb, a-colien.ads,
g-alveop.adb, gnat.ads, s-diinio.adb, a-cfdlli.adb, g-pehage.adb,
a-wtmoio.ads, a-stwiha.adb, a-locale.adb, a-tirsfi.adb, a-nscoty.ads,
a-rbtgbo.ads, s-pack12.adb, a-cofuse.ads, a-sfteio.ads, s-io.ads,
g-alveop.ads, a-cfdlli.ads, s-diinio.ads, a-stwiha.ads, g-pehage.ads,
a-locale.ads, a-tirsfi.ads, s-pack12.ads, s-valuti.adb, g-cppexc.adb,
system-vxworks-ppc.ads, g-memdum.adb, a-lfteio.ads, s-pack21.adb,
s-unstyp.ads, s-valuti.ads, g-cppexc.ads, system-hpux-ia64.ads,
g-memdum.ads, g-soccon.ads, g-altive.ads, a-crbtgo.adb, s-pack21.ads,
a-llizti.ads, a-numaux-libc-x86.ads, s-expint.adb, s-conca8.adb,
a-crbtgo.ads, s-pack30.adb, s-vallli.adb, s-geveop.adb, s-expint.ads,
a-direio.adb, s-conca8.ads, a-widcha.ads, s-pack30.ads, s-vallli.ads,
s-strhas.adb, s-geveop.ads, g-md5.adb, a-direio.ads, a-numaux.ads,
s-ransee.adb, a-szbzha.adb, i-cobol.adb, g-busorg.adb, s-strhas.ads,
g-md5.ads, s-widenu.adb, s-ransee.ads, s-widllu.adb, a-szbzha.ads,
a-ststio.adb, i-cobol.ads, g-busorg.ads, g-regpat.adb, s-widenu.ads,
a-secain.adb, s-widllu.ads, s-pack13.adb, g-encstr.adb, a-ztcoau.adb,
a-ststio.ads, s-widwch.adb, g-regpat.ads, s-atacco.adb, a-cborse.adb,
a-secain.ads, s-pack13.ads, g-encstr.ads, a-ztcoau.ads, s-widwch.ads,
g-io_aux.adb, s-atacco.ads, a-ncelfu.ads, interfac.ads, a-cborse.ads,
g-regexp.adb, s-pack22.adb, a-szuzti.adb, g-io_aux.ads, s-caun32.adb,
a-nselfu.ads, g-regexp.ads, s-pack22.ads, a-ticoio.adb, a-szuzti.ads,
g-diopit.adb, s-caun32.ads, s-conca9.adb, a-tags.adb, a-swmwco.ads,
a-sbecin.adb, s-pack31.adb, s-expuns.adb, a-ticoio.ads, s-valint.adb,
s-conca9.ads, g-diopit.ads, a-tags.ads, a-nllcef.ads, a-izteio.ads,
a-sbecin.ads, s-expuns.ads, s-pack31.ads, g-dyntab.adb, s-powtab.ads,
s-flocon-none.adb, s-valint.ads, a-ssiwti.ads, s-mmosin-mingw.adb,
s-pack40.adb, s-pack05.adb, a-ztflau.adb, g-dyntab.ads,
a-szuzti-shared.adb, g-alvevi.ads, a-stwise.adb, s-mmosin-mingw.ads,
s-pack40.ads, a-diocst.adb, a-ztflau.ads, s-pack05.ads, a-nlcoty.ads,
a-contai.ads, a-stwisu.adb, g-byorma.adb, a-siwtio.ads, a-stwise.ads,
s-regpat.adb, g-mbdira.adb, s-pack14.adb, a-diocst.ads, g-flocon.ads,
g-mbflra.adb, a-ztinau.adb, s-dim.ads, s-mantis.adb, a-stwisu.ads,
g-byorma.ads, s-atopri.adb, g-wistsp.ads, a-uncdea.ads, s-widcha.adb,
a-caldel.adb, s-regpat.ads, g-mbdira.ads, a-tiflio.adb, s-pack14.ads,
s-parame.adb, a-liwtio.ads, s-memory.adb, g-mbflra.ads, a-ztinau.ads,
a-wtgeau.adb, s-direio.adb, s-mantis.ads, s-atopri.ads, s-widcha.ads,
a-caldel.ads, s-pack23.adb, a-unccon.ads, a-tiflio.ads, s-parame.ads,
a-llftio.ads, s-memory.ads, s-regexp.adb, a-wtgeau.ads, a-exexda.adb,
s-direio.ads, s-pack23.ads, g-stheme.adb, a-tiinio.adb, g-sestin.ads,
s-regexp.ads, a-wtfiio.adb, a-comutr.adb, a-exexpr.adb, a-tiinio.ads,
a-ztmoau.adb, a-cohata.ads, a-wtfiio.ads, s-imgrea.adb, ada.ads,
a-szunau-shared.adb, a-comutr.ads, s-valuns.adb, a-ztmoau.ads,
system-linux-arm.ads, s-osprim-x32.adb, s-pack41.adb, s-pack06.adb,
s-imgrea.ads, s-valuns.ads, s-finroo.adb, s-caun16.adb, s-pooglo.adb,
a-zrstfi.adb, a-suenst.adb, s-pack41.ads, g-binenv.adb, s-pack06.ads,
a-calari.adb, a-nlcoar.ads, s-finroo.ads, a-timoio.adb, s-caun16.ads,
s-flocon.adb, a-suenst.ads, a-zrstfi.ads, s-pooglo.ads, s-wchcon.adb,
s-traceb-hpux.adb, s-pack50.adb, i-fortra.adb, s-pack15.adb,
a-ngcefu.adb, g-sptavs.ads, g-binenv.ads, s-wchjis.adb, a-calari.ads,
a-timoio.ads, a-decima.adb, s-flocon.ads, s-wchcon.ads, a-llfzti.ads,
i-fortra.ads, s-pack50.ads, s-pack15.ads, a-ngcefu.ads, a-cfhase.adb,
s-wchjis.ads, g-soliop.ads, a-decima.ads, a-chlat9.ads, s-pack24.adb,
a-nlelfu.ads, a-cfhase.ads, g-locfil.adb, s-atocou-builtin.adb,
s-memcop.ads, a-szunau.adb, s-pack24.ads, s-imgllb.adb, s-auxdec.adb,
g-locfil.ads, s-pack33.adb, a-szunau.ads, s-parame-vxworks.adb,
s-imgllb.ads, a-ciorma.adb, s-auxdec.ads, a-cobove.adb, s-dsaser.ads,
a-elchha.adb, s-pack33.ads, a-cofuve.adb, s-parame-vxworks.ads,
a-ciorma.ads, system-darwin-x86.ads, s-multip.adb, a-stwiun-shared.adb,
a-wichun.adb, a-cobove.ads, s-imgbiu.adb, s-tsmona-mingw.adb,
a-coormu.adb, a-siocst.adb, s-win32.ads, a-elchha.ads, s-pack42.adb,
s-pack07.adb, a-cofuve.ads, system-hpux.ads, a-teioed.adb,
a-convec.adb, g-speche.adb, s-multip.ads, a-stwiun-shared.ads,
a-wichun.ads, s-imgbiu.ads, a-numeri.ads, a-siocst.ads, a-coormu.ads,
a-lliwti.ads, s-pack42.ads, s-pack07.ads, a-teioed.ads, a-convec.ads,
g-speche.ads, g-socthi.adb, a-nucoty.ads, a-szmzco.ads, s-pack51.adb,
s-osprim-mingw.adb, s-casi64.adb, g-strspl.ads, g-socthi.ads,
g-socket-dummy.adb, s-pack51.ads, s-dimmks.ads, s-casi64.ads,
a-wtenau.adb, s-stchop-vxworks.adb, s-pack60.adb,
system-solaris-sparc.ads, s-pack25.adb, g-socket-dummy.ads,
a-exstat.adb, a-cofuma.adb, s-tsmona-linux.adb, a-wtenau.ads,
s-pack60.ads, s-pack25.ads, i-cstrea.adb, a-cofuma.ads, g-exptty.adb,
a-chzla1.ads, s-pack34.adb, i-cstrea.ads, s-excdeb.adb, a-iteint.ads,
g-exptty.ads, i-pacdec.adb, s-pack34.ads, s-rident.ads, s-sopco3.adb,
i-vxwork.ads, s-excdeb.ads, system-linux-ppc.ads, a-swuwti-shared.adb,
s-widlli.adb, s-pack43.adb, i-pacdec.ads, a-cwila9.ads, s-sopco3.ads,
a-fwteio.ads, s-widlli.ads, s-pack43.ads, a-suhcin.adb, a-wtdeau.adb,
g-allein.ads, a-suezst.adb, a-dirval-mingw.adb, g-zspche.adb,
s-bignum.adb, a-ztedit.adb, g-regist.adb, a-nllefu.ads, a-ztcoio.adb,
s-pack52.adb, a-llctio.ads, a-nucoar.ads, s-pack17.adb, a-suhcin.ads,
a-wtdeau.ads, a-suezst.ads, a-dirval.adb, g-zspche.ads, g-regist.ads,
a-ztedit.ads, s-bignum.ads, a-wtcstr.adb, system.ads, s-pack52.ads,
a-ztcoio.ads, s-pack17.ads, s-imgboo.adb, a-rbtgso.adb, a-dirval.ads,
a-cohase.adb, s-pack61.adb, a-wtcstr.ads, s-pack26.adb, s-osprim.ads,
a-tigeau.adb, s-imgboo.ads, a-nuelfu.ads, a-swfwha.ads, s-commun.adb,
g-socthi-vxworks.adb, a-rbtgso.ads, a-cohase.ads, g-zstspl.ads,
s-pack61.ads, s-pack26.ads, a-intnam-dragonfly.ads, s-imglld.adb,
a-tigeau.ads, s-commun.ads, g-socthi-vxworks.ads, a-cborma.adb,
a-stwifi.adb, g-moreex.adb, s-pack35.adb, s-imglld.ads, s-valdec.adb,
a-tifiio.adb, a-cborma.ads, g-moreex.ads, a-stwifi.ads, s-pack35.ads,
s-sopco4.adb, g-sha224.ads, g-socket.adb, a-intnam-rtems.ads,
s-finmas.adb, s-valdec.ads, s-addima.adb, a-finali.adb, a-tifiio.ads,
s-rpc.adb, a-ztflio.adb, s-pack44.adb, s-pack09.adb, a-sblcin.adb,
s-sopco4.ads, a-textio.adb, g-socket.ads, g-sptabo.ads, s-finmas.ads,
g-shsh32.adb, s-addima.ads, a-finali.ads, s-mmauni-long.ads, s-rpc.ads,
a-ztflio.ads, system-djgpp.ads, s-stache.adb, s-pack44.ads,
s-pack09.ads, a-sblcin.ads, a-textio.ads, a-cidlli.adb, g-shsh32.ads,
a-chtgbk.adb, a-tiocst.adb, s-pack53.adb, s-pack18.adb, s-stache.ads,
a-zchhan.adb, s-fatlfl.ads, a-ztinio.adb, s-strops.adb, a-siteio.ads,
a-cidlli.ads, a-chtgbk.ads, g-ssvety.ads, a-tiocst.ads, s-pack53.ads,
s-parame-hpux.ads, s-pack18.ads, a-zchhan.ads, s-strops.ads,
a-ztinio.ads, a-wichha.adb, a-stwima.adb, a-nlrear.ads, a-liteio.ads,
s-pack62.adb, s-pack27.adb, s-fore.adb, s-vercon.adb, a-wichha.ads,
a-stwima.ads, s-pack62.ads, system-linux-sparc.ads, s-pack27.ads,
g-dynhta.adb, s-fore.ads, s-vercon.ads, a-cofuba.adb, a-cimutr.adb,
i-cpoint.adb, s-imgenu.adb, a-stwibo.adb, s-pack36.adb, i-cstrin.adb,
s-imgllu.adb, a-suteio-shared.adb, g-excact.adb, s-stoele.adb,
s-addope.adb, g-dynhta.ads, a-cofuba.ads, a-ztmoio.adb, a-llfwti.ads,
a-cimutr.ads, i-cpoint.ads, s-imgenu.ads, a-stwibo.ads, a-wttest.adb,
s-pack36.ads, a-tgdico.ads, s-sopco5.adb, s-scaval.adb, i-cstrin.ads,
s-imgllu.ads, g-excact.ads, s-stoele.ads, g-deutst.ads, s-addope.ads,
s-imgwch.adb, g-sha384.ads, a-ztmoio.ads, s-pack45.adb, a-wttest.ads,
s-sopco5.ads, s-excmac-gcc.adb, s-scaval.ads, a-storio.adb,
a-coinho.adb, a-btgbso.adb, s-imgwch.ads, s-carun8.adb, memtrack.adb,
s-pack45.ads, a-sfhcin.ads, s-excmac-gcc.ads, a-storio.ads,
a-coinho.ads, a-btgbso.ads, s-stratt.adb, s-carun8.ads, a-shcain.adb,
s-pack54.adb, s-pack19.adb, a-colire.adb, a-tigeli.adb, s-caun64.adb,
s-stratt.ads, s-fatgen.adb, a-shcain.ads, a-stzunb-shared.adb,
s-pack54.ads, s-pack19.ads, a-colire.ads, a-calcon.adb, s-caun64.ads,
s-fatgen.ads, s-pack63.adb, g-arrspl.adb, a-stzunb-shared.ads,
s-pack28.adb, a-nllrar.ads, a-zzboio.adb, a-zzunio.ads, a-stunau.adb,
a-calcon.ads, g-cgideb.adb, s-objrea.adb, s-mastop.adb, a-tienau.adb,
g-altcon.adb, g-arrspl.ads, s-pack63.ads, s-restri.adb, s-pack28.ads,
a-zzboio.ads, a-stunau.ads, g-cgideb.ads, g-htable.adb, g-sothco.adb,
s-objrea.ads, g-soliop-solaris.ads, s-mastop.ads, a-tienau.ads,
system-linux-m68k.ads, g-altcon.ads, s-dmotpr.ads, s-memory-mingw.adb,
g-cgicoo.adb, s-pack37.adb, s-restri.ads, s-fatllf.ads, s-expmod.adb,
a-swuwha.adb, a-exextr.adb, a-cfhama.adb, s-gloloc-mingw.adb,
a-tiboio.adb, g-forstr.adb, g-sothco.ads, a-stzbou.adb, a-nllcty.ads,
a-suecin.adb, g-htable.ads, s-exctab.adb, a-tiunio.ads, g-cgicoo.ads,
s-osprim-posix.adb, s-pack37.ads, a-ciormu.adb, s-atocou-x86.adb,
a-swuwha.ads, s-expmod.ads, a-cfhama.ads, s-ficobl.ads, a-ngcoty.adb,
g-forstr.ads, a-tiboio.ads, a-calfor.adb, a-stzbou.ads, a-suecin.ads,
a-conhel.adb, a-crbltr.ads, s-exctab.ads, a-dhfina.ads, s-imgcha.adb,
s-pack46.adb, a-ciormu.ads, system-linux-sh4.ads, a-chahan.adb,
a-ngcoty.ads, a-stzunb.adb, a-szfzha.ads, a-calfor.ads, a-cbdlli.adb,
a-conhel.ads, s-imgcha.ads, s-pack46.ads, a-assert.adb, a-chahan.ads,
a-stzunb.ads, a-crdlli.adb, s-pack55.adb, a-cbdlli.ads, a-tideau.adb,
a-assert.ads, ioexcept.ads, s-boarop.ads, g-hesora.adb, a-crdlli.ads,
s-pack55.ads, a-tideau.ads, g-bubsor.adb, a-wtenio.adb, a-cbsyqu.adb,
g-hesora.ads, s-pack29.adb, a-nurear.ads, g-catiio.adb, s-stposu.adb,
g-bubsor.ads, a-wtenio.ads, a-cbsyqu.ads, a-suewst.adb,
system-vxworks-x86.ads, s-pack29.ads, a-cbmutr.adb, a-cbprqu.adb,
s-imenne.adb, g-sothco-dummy.adb, g-casuti.adb, g-catiio.ads,
s-stposu.ads, a-stzsea.adb, s-pack38.adb, a-suewst.ads, s-imgllw.adb,
a-cbprqu.ads, a-cbmutr.ads, s-imenne.ads, g-sothco-dummy.ads,
g-casuti.ads, s-htable.adb, s-fatsfl.ads, g-trasym.adb, unchconv.ads,
a-stzsea.ads, s-arit64.adb, s-pack38.ads, a-nllcar.ads, s-valrea.adb,
s-imgllw.ads, s-htable.ads, a-sequio.adb, g-trasym.ads, a-ngcoar.adb,
s-exnllf.adb, s-pack47.adb, s-arit64.ads, g-sercom-mingw.adb,
s-valrea.ads, g-socthi-mingw.adb, g-bytswa.adb, g-sehash.adb,
unchdeal.ads, a-sequio.ads, a-ngcoar.ads, s-exnllf.ads, a-wtdeio.adb,
s-pack47.ads, g-socthi-mingw.ads, a-excpol-abort.adb, a-ztgeau.adb,
g-bytswa.ads, g-sehash.ads, s-pack56.adb, a-wtdeio.ads, a-ngelfu.adb,
a-ztgeau.ads, a-cforse.adb, s-filatt.ads, a-stzfix.adb, a-cihase.adb,
s-pack56.ads, a-sfztio.ads, a-ngelfu.ads, s-trasym-dwarf.adb,
a-cforse.ads, a-ztfiio.adb, g-timsta.adb, a-stzfix.ads, a-cihase.ads,
a-ztfiio.ads, system-darwin-arm.ads: Move non-tasking runtime sources
to libgnat subdirectory.
From-SVN: r251902
Diffstat (limited to 'gcc/ada/libgnat/g-socket.adb')
| -rw-r--r-- | gcc/ada/libgnat/g-socket.adb | 2786 |
1 files changed, 2786 insertions, 0 deletions
diff --git a/gcc/ada/libgnat/g-socket.adb b/gcc/ada/libgnat/g-socket.adb new file mode 100644 index 0000000..9b2ad7f --- /dev/null +++ b/gcc/ada/libgnat/g-socket.adb @@ -0,0 +1,2786 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G N A T . S O C K E T S -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2001-2017, AdaCore -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with Ada.Streams; use Ada.Streams; +with Ada.Exceptions; use Ada.Exceptions; +with Ada.Finalization; +with Ada.Unchecked_Conversion; + +with GNAT.Sockets.Thin_Common; use GNAT.Sockets.Thin_Common; +with GNAT.Sockets.Thin; use GNAT.Sockets.Thin; + +with GNAT.Sockets.Linker_Options; +pragma Warnings (Off, GNAT.Sockets.Linker_Options); +-- Need to include pragma Linker_Options which is platform dependent + +with System; use System; +with System.Communication; use System.Communication; +with System.CRTL; use System.CRTL; +with System.Task_Lock; + +package body GNAT.Sockets is + + package C renames Interfaces.C; + + ENOERROR : constant := 0; + + Netdb_Buffer_Size : constant := SOSC.Need_Netdb_Buffer * 1024; + Need_Netdb_Lock : constant Boolean := SOSC.Need_Netdb_Lock /= 0; + -- The network database functions gethostbyname, gethostbyaddr, + -- getservbyname and getservbyport can either be guaranteed task safe by + -- the operating system, or else return data through a user-provided buffer + -- to ensure concurrent uses do not interfere. + + -- Correspondence tables + + Levels : constant array (Level_Type) of C.int := + (Socket_Level => SOSC.SOL_SOCKET, + IP_Protocol_For_IP_Level => SOSC.IPPROTO_IP, + IP_Protocol_For_UDP_Level => SOSC.IPPROTO_UDP, + IP_Protocol_For_TCP_Level => SOSC.IPPROTO_TCP); + + Modes : constant array (Mode_Type) of C.int := + (Socket_Stream => SOSC.SOCK_STREAM, + Socket_Datagram => SOSC.SOCK_DGRAM); + + Shutmodes : constant array (Shutmode_Type) of C.int := + (Shut_Read => SOSC.SHUT_RD, + Shut_Write => SOSC.SHUT_WR, + Shut_Read_Write => SOSC.SHUT_RDWR); + + Requests : constant array (Request_Name) of SOSC.IOCTL_Req_T := + (Non_Blocking_IO => SOSC.FIONBIO, + N_Bytes_To_Read => SOSC.FIONREAD); + + Options : constant array (Specific_Option_Name) of C.int := + (Keep_Alive => SOSC.SO_KEEPALIVE, + Reuse_Address => SOSC.SO_REUSEADDR, + Broadcast => SOSC.SO_BROADCAST, + Send_Buffer => SOSC.SO_SNDBUF, + Receive_Buffer => SOSC.SO_RCVBUF, + Linger => SOSC.SO_LINGER, + Error => SOSC.SO_ERROR, + No_Delay => SOSC.TCP_NODELAY, + Add_Membership => SOSC.IP_ADD_MEMBERSHIP, + Drop_Membership => SOSC.IP_DROP_MEMBERSHIP, + Multicast_If => SOSC.IP_MULTICAST_IF, + Multicast_TTL => SOSC.IP_MULTICAST_TTL, + Multicast_Loop => SOSC.IP_MULTICAST_LOOP, + Receive_Packet_Info => SOSC.IP_PKTINFO, + Send_Timeout => SOSC.SO_SNDTIMEO, + Receive_Timeout => SOSC.SO_RCVTIMEO, + Busy_Polling => SOSC.SO_BUSY_POLL); + -- ??? Note: for OpenSolaris, Receive_Packet_Info should be IP_RECVPKTINFO, + -- but for Linux compatibility this constant is the same as IP_PKTINFO. + + Flags : constant array (0 .. 3) of C.int := + (0 => SOSC.MSG_OOB, -- Process_Out_Of_Band_Data + 1 => SOSC.MSG_PEEK, -- Peek_At_Incoming_Data + 2 => SOSC.MSG_WAITALL, -- Wait_For_A_Full_Reception + 3 => SOSC.MSG_EOR); -- Send_End_Of_Record + + Socket_Error_Id : constant Exception_Id := Socket_Error'Identity; + Host_Error_Id : constant Exception_Id := Host_Error'Identity; + + Hex_To_Char : constant String (1 .. 16) := "0123456789ABCDEF"; + -- Use to print in hexadecimal format + + ----------------------- + -- Local subprograms -- + ----------------------- + + function Resolve_Error + (Error_Value : Integer; + From_Errno : Boolean := True) return Error_Type; + -- Associate an enumeration value (error_type) to an error value (errno). + -- From_Errno prevents from mixing h_errno with errno. + + function To_Name (N : String) return Name_Type; + function To_String (HN : Name_Type) return String; + -- Conversion functions + + function To_Int (F : Request_Flag_Type) return C.int; + -- Return the int value corresponding to the specified flags combination + + function Set_Forced_Flags (F : C.int) return C.int; + -- Return F with the bits from SOSC.MSG_Forced_Flags forced set + + function Short_To_Network + (S : C.unsigned_short) return C.unsigned_short; + pragma Inline (Short_To_Network); + -- Convert a port number into a network port number + + function Network_To_Short + (S : C.unsigned_short) return C.unsigned_short + renames Short_To_Network; + -- Symmetric operation + + function Image + (Val : Inet_Addr_VN_Type; + Hex : Boolean := False) return String; + -- Output an array of inet address components in hex or decimal mode + + function Is_IP_Address (Name : String) return Boolean; + -- Return true when Name is an IPv4 address in dotted quad notation + + procedure Netdb_Lock; + pragma Inline (Netdb_Lock); + procedure Netdb_Unlock; + pragma Inline (Netdb_Unlock); + -- Lock/unlock operation used to protect netdb access for platforms that + -- require such protection. + + function To_In_Addr (Addr : Inet_Addr_Type) return In_Addr; + procedure To_Inet_Addr + (Addr : In_Addr; + Result : out Inet_Addr_Type); + -- Conversion functions + + function To_Host_Entry (E : Hostent_Access) return Host_Entry_Type; + -- Conversion function + + function To_Service_Entry (E : Servent_Access) return Service_Entry_Type; + -- Conversion function + + function Value (S : System.Address) return String; + -- Same as Interfaces.C.Strings.Value but taking a System.Address + + function To_Timeval (Val : Timeval_Duration) return Timeval; + -- Separate Val in seconds and microseconds + + function To_Duration (Val : Timeval) return Timeval_Duration; + -- Reconstruct a Duration value from a Timeval record (seconds and + -- microseconds). + + procedure Raise_Socket_Error (Error : Integer); + -- Raise Socket_Error with an exception message describing the error code + -- from errno. + + procedure Raise_Host_Error (H_Error : Integer; Name : String); + -- Raise Host_Error exception with message describing error code (note + -- hstrerror seems to be obsolete) from h_errno. Name is the name + -- or address that was being looked up. + + procedure Narrow (Item : in out Socket_Set_Type); + -- Update Last as it may be greater than the real last socket + + procedure Check_For_Fd_Set (Fd : Socket_Type); + pragma Inline (Check_For_Fd_Set); + -- Raise Constraint_Error if Fd is less than 0 or greater than or equal to + -- FD_SETSIZE, on platforms where fd_set is a bitmap. + + function Connect_Socket + (Socket : Socket_Type; + Server : Sock_Addr_Type) return C.int; + pragma Inline (Connect_Socket); + -- Underlying implementation for the Connect_Socket procedures + + -- Types needed for Datagram_Socket_Stream_Type + + type Datagram_Socket_Stream_Type is new Root_Stream_Type with record + Socket : Socket_Type; + To : Sock_Addr_Type; + From : Sock_Addr_Type; + end record; + + type Datagram_Socket_Stream_Access is + access all Datagram_Socket_Stream_Type; + + procedure Read + (Stream : in out Datagram_Socket_Stream_Type; + Item : out Ada.Streams.Stream_Element_Array; + Last : out Ada.Streams.Stream_Element_Offset); + + procedure Write + (Stream : in out Datagram_Socket_Stream_Type; + Item : Ada.Streams.Stream_Element_Array); + + -- Types needed for Stream_Socket_Stream_Type + + type Stream_Socket_Stream_Type is new Root_Stream_Type with record + Socket : Socket_Type; + end record; + + type Stream_Socket_Stream_Access is + access all Stream_Socket_Stream_Type; + + procedure Read + (Stream : in out Stream_Socket_Stream_Type; + Item : out Ada.Streams.Stream_Element_Array; + Last : out Ada.Streams.Stream_Element_Offset); + + procedure Write + (Stream : in out Stream_Socket_Stream_Type; + Item : Ada.Streams.Stream_Element_Array); + + procedure Wait_On_Socket + (Socket : Socket_Type; + For_Read : Boolean; + Timeout : Selector_Duration; + Selector : access Selector_Type := null; + Status : out Selector_Status); + -- Common code for variants of socket operations supporting a timeout: + -- block in Check_Selector on Socket for at most the indicated timeout. + -- If For_Read is True, Socket is added to the read set for this call, else + -- it is added to the write set. If no selector is provided, a local one is + -- created for this call and destroyed prior to returning. + + type Sockets_Library_Controller is new Ada.Finalization.Limited_Controlled + with null record; + -- This type is used to generate automatic calls to Initialize and Finalize + -- during the elaboration and finalization of this package. A single object + -- of this type must exist at library level. + + function Err_Code_Image (E : Integer) return String; + -- Return the value of E surrounded with brackets + + procedure Initialize (X : in out Sockets_Library_Controller); + procedure Finalize (X : in out Sockets_Library_Controller); + + procedure Normalize_Empty_Socket_Set (S : in out Socket_Set_Type); + -- If S is the empty set (detected by Last = No_Socket), make sure its + -- fd_set component is actually cleared. Note that the case where it is + -- not can occur for an uninitialized Socket_Set_Type object. + + function Is_Open (S : Selector_Type) return Boolean; + -- Return True for an "open" Selector_Type object, i.e. one for which + -- Create_Selector has been called and Close_Selector has not been called, + -- or the null selector. + + --------- + -- "+" -- + --------- + + function "+" (L, R : Request_Flag_Type) return Request_Flag_Type is + begin + return L or R; + end "+"; + + -------------------- + -- Abort_Selector -- + -------------------- + + procedure Abort_Selector (Selector : Selector_Type) is + Res : C.int; + + begin + if not Is_Open (Selector) then + raise Program_Error with "closed selector"; + + elsif Selector.Is_Null then + raise Program_Error with "null selector"; + + end if; + + -- Send one byte to unblock select system call + + Res := Signalling_Fds.Write (C.int (Selector.W_Sig_Socket)); + + if Res = Failure then + Raise_Socket_Error (Socket_Errno); + end if; + end Abort_Selector; + + ------------------- + -- Accept_Socket -- + ------------------- + + procedure Accept_Socket + (Server : Socket_Type; + Socket : out Socket_Type; + Address : out Sock_Addr_Type) + is + Res : C.int; + Sin : aliased Sockaddr_In; + Len : aliased C.int := Sin'Size / 8; + + begin + Res := C_Accept (C.int (Server), Sin'Address, Len'Access); + + if Res = Failure then + Raise_Socket_Error (Socket_Errno); + end if; + + Socket := Socket_Type (Res); + + To_Inet_Addr (Sin.Sin_Addr, Address.Addr); + Address.Port := Port_Type (Network_To_Short (Sin.Sin_Port)); + end Accept_Socket; + + ------------------- + -- Accept_Socket -- + ------------------- + + procedure Accept_Socket + (Server : Socket_Type; + Socket : out Socket_Type; + Address : out Sock_Addr_Type; + Timeout : Selector_Duration; + Selector : access Selector_Type := null; + Status : out Selector_Status) + is + begin + if Selector /= null and then not Is_Open (Selector.all) then + raise Program_Error with "closed selector"; + end if; + + -- Wait for socket to become available for reading + + Wait_On_Socket + (Socket => Server, + For_Read => True, + Timeout => Timeout, + Selector => Selector, + Status => Status); + + -- Accept connection if available + + if Status = Completed then + Accept_Socket (Server, Socket, Address); + else + Socket := No_Socket; + end if; + end Accept_Socket; + + --------------- + -- Addresses -- + --------------- + + function Addresses + (E : Host_Entry_Type; + N : Positive := 1) return Inet_Addr_Type + is + begin + return E.Addresses (N); + end Addresses; + + ---------------------- + -- Addresses_Length -- + ---------------------- + + function Addresses_Length (E : Host_Entry_Type) return Natural is + begin + return E.Addresses_Length; + end Addresses_Length; + + ------------- + -- Aliases -- + ------------- + + function Aliases + (E : Host_Entry_Type; + N : Positive := 1) return String + is + begin + return To_String (E.Aliases (N)); + end Aliases; + + ------------- + -- Aliases -- + ------------- + + function Aliases + (S : Service_Entry_Type; + N : Positive := 1) return String + is + begin + return To_String (S.Aliases (N)); + end Aliases; + + -------------------- + -- Aliases_Length -- + -------------------- + + function Aliases_Length (E : Host_Entry_Type) return Natural is + begin + return E.Aliases_Length; + end Aliases_Length; + + -------------------- + -- Aliases_Length -- + -------------------- + + function Aliases_Length (S : Service_Entry_Type) return Natural is + begin + return S.Aliases_Length; + end Aliases_Length; + + ----------------- + -- Bind_Socket -- + ----------------- + + procedure Bind_Socket + (Socket : Socket_Type; + Address : Sock_Addr_Type) + is + Res : C.int; + Sin : aliased Sockaddr_In; + Len : constant C.int := Sin'Size / 8; + -- This assumes that Address.Family = Family_Inet??? + + begin + if Address.Family = Family_Inet6 then + raise Socket_Error with "IPv6 not supported"; + end if; + + Set_Family (Sin.Sin_Family, Address.Family); + Set_Address (Sin'Unchecked_Access, To_In_Addr (Address.Addr)); + Set_Port + (Sin'Unchecked_Access, + Short_To_Network (C.unsigned_short (Address.Port))); + + Res := C_Bind (C.int (Socket), Sin'Address, Len); + + if Res = Failure then + Raise_Socket_Error (Socket_Errno); + end if; + end Bind_Socket; + + ---------------------- + -- Check_For_Fd_Set -- + ---------------------- + + procedure Check_For_Fd_Set (Fd : Socket_Type) is + use SOSC; + + begin + -- On Windows, fd_set is a FD_SETSIZE array of socket ids: + -- no check required. Warnings suppressed because condition + -- is known at compile time. + + if Target_OS = Windows then + + return; + + -- On other platforms, fd_set is an FD_SETSIZE bitmap: check + -- that Fd is within range (otherwise behavior is undefined). + + elsif Fd < 0 or else Fd >= SOSC.FD_SETSIZE then + raise Constraint_Error + with "invalid value for socket set: " & Image (Fd); + end if; + end Check_For_Fd_Set; + + -------------------- + -- Check_Selector -- + -------------------- + + procedure Check_Selector + (Selector : Selector_Type; + R_Socket_Set : in out Socket_Set_Type; + W_Socket_Set : in out Socket_Set_Type; + Status : out Selector_Status; + Timeout : Selector_Duration := Forever) + is + E_Socket_Set : Socket_Set_Type; + begin + Check_Selector + (Selector, R_Socket_Set, W_Socket_Set, E_Socket_Set, Status, Timeout); + end Check_Selector; + + procedure Check_Selector + (Selector : Selector_Type; + R_Socket_Set : in out Socket_Set_Type; + W_Socket_Set : in out Socket_Set_Type; + E_Socket_Set : in out Socket_Set_Type; + Status : out Selector_Status; + Timeout : Selector_Duration := Forever) + is + Res : C.int; + Last : C.int; + RSig : Socket_Type := No_Socket; + TVal : aliased Timeval; + TPtr : Timeval_Access; + + begin + if not Is_Open (Selector) then + raise Program_Error with "closed selector"; + end if; + + Status := Completed; + + -- No timeout or Forever is indicated by a null timeval pointer + + if Timeout = Forever then + TPtr := null; + else + TVal := To_Timeval (Timeout); + TPtr := TVal'Unchecked_Access; + end if; + + -- Add read signalling socket, if present + + if not Selector.Is_Null then + RSig := Selector.R_Sig_Socket; + Set (R_Socket_Set, RSig); + end if; + + Last := C.int'Max (C.int'Max (C.int (R_Socket_Set.Last), + C.int (W_Socket_Set.Last)), + C.int (E_Socket_Set.Last)); + + -- Zero out fd_set for empty Socket_Set_Type objects + + Normalize_Empty_Socket_Set (R_Socket_Set); + Normalize_Empty_Socket_Set (W_Socket_Set); + Normalize_Empty_Socket_Set (E_Socket_Set); + + Res := + C_Select + (Last + 1, + R_Socket_Set.Set'Access, + W_Socket_Set.Set'Access, + E_Socket_Set.Set'Access, + TPtr); + + if Res = Failure then + Raise_Socket_Error (Socket_Errno); + end if; + + -- If Select was resumed because of read signalling socket, read this + -- data and remove socket from set. + + if RSig /= No_Socket and then Is_Set (R_Socket_Set, RSig) then + Clear (R_Socket_Set, RSig); + + Res := Signalling_Fds.Read (C.int (RSig)); + + if Res = Failure then + Raise_Socket_Error (Socket_Errno); + end if; + + Status := Aborted; + + elsif Res = 0 then + Status := Expired; + end if; + + -- Update socket sets in regard to their new contents + + Narrow (R_Socket_Set); + Narrow (W_Socket_Set); + Narrow (E_Socket_Set); + end Check_Selector; + + ----------- + -- Clear -- + ----------- + + procedure Clear + (Item : in out Socket_Set_Type; + Socket : Socket_Type) + is + Last : aliased C.int := C.int (Item.Last); + + begin + Check_For_Fd_Set (Socket); + + if Item.Last /= No_Socket then + Remove_Socket_From_Set (Item.Set'Access, C.int (Socket)); + Last_Socket_In_Set (Item.Set'Access, Last'Unchecked_Access); + Item.Last := Socket_Type (Last); + end if; + end Clear; + + -------------------- + -- Close_Selector -- + -------------------- + + procedure Close_Selector (Selector : in out Selector_Type) is + begin + -- Nothing to do if selector already in closed state + + if Selector.Is_Null or else not Is_Open (Selector) then + return; + end if; + + -- Close the signalling file descriptors used internally for the + -- implementation of Abort_Selector. + + Signalling_Fds.Close (C.int (Selector.R_Sig_Socket)); + Signalling_Fds.Close (C.int (Selector.W_Sig_Socket)); + + -- Reset R_Sig_Socket and W_Sig_Socket to No_Socket to ensure that any + -- (erroneous) subsequent attempt to use this selector properly fails. + + Selector.R_Sig_Socket := No_Socket; + Selector.W_Sig_Socket := No_Socket; + end Close_Selector; + + ------------------ + -- Close_Socket -- + ------------------ + + procedure Close_Socket (Socket : Socket_Type) is + Res : C.int; + + begin + Res := C_Close (C.int (Socket)); + + if Res = Failure then + Raise_Socket_Error (Socket_Errno); + end if; + end Close_Socket; + + -------------------- + -- Connect_Socket -- + -------------------- + + function Connect_Socket + (Socket : Socket_Type; + Server : Sock_Addr_Type) return C.int + is + Sin : aliased Sockaddr_In; + Len : constant C.int := Sin'Size / 8; + + begin + if Server.Family = Family_Inet6 then + raise Socket_Error with "IPv6 not supported"; + end if; + + Set_Family (Sin.Sin_Family, Server.Family); + Set_Address (Sin'Unchecked_Access, To_In_Addr (Server.Addr)); + Set_Port + (Sin'Unchecked_Access, + Short_To_Network (C.unsigned_short (Server.Port))); + + return C_Connect (C.int (Socket), Sin'Address, Len); + end Connect_Socket; + + procedure Connect_Socket + (Socket : Socket_Type; + Server : Sock_Addr_Type) + is + begin + if Connect_Socket (Socket, Server) = Failure then + Raise_Socket_Error (Socket_Errno); + end if; + end Connect_Socket; + + procedure Connect_Socket + (Socket : Socket_Type; + Server : Sock_Addr_Type; + Timeout : Selector_Duration; + Selector : access Selector_Type := null; + Status : out Selector_Status) + is + Req : Request_Type; + -- Used to set Socket to non-blocking I/O + + Conn_Err : aliased Integer; + -- Error status of the socket after completion of select(2) + + Res : C.int; + Conn_Err_Size : aliased C.int := Conn_Err'Size / 8; + -- For getsockopt(2) call + + begin + if Selector /= null and then not Is_Open (Selector.all) then + raise Program_Error with "closed selector"; + end if; + + -- Set the socket to non-blocking I/O + + Req := (Name => Non_Blocking_IO, Enabled => True); + Control_Socket (Socket, Request => Req); + + -- Start operation (non-blocking), will return Failure with errno set + -- to EINPROGRESS. + + Res := Connect_Socket (Socket, Server); + if Res = Failure then + Conn_Err := Socket_Errno; + if Conn_Err /= SOSC.EINPROGRESS then + Raise_Socket_Error (Conn_Err); + end if; + end if; + + -- Wait for socket to become available for writing (unless the Timeout + -- is zero, in which case we consider that it has already expired, and + -- we do not need to wait at all). + + if Timeout = 0.0 then + Status := Expired; + + else + Wait_On_Socket + (Socket => Socket, + For_Read => False, + Timeout => Timeout, + Selector => Selector, + Status => Status); + end if; + + -- Check error condition (the asynchronous connect may have terminated + -- with an error, e.g. ECONNREFUSED) if select(2) completed. + + if Status = Completed then + Res := C_Getsockopt + (C.int (Socket), SOSC.SOL_SOCKET, SOSC.SO_ERROR, + Conn_Err'Address, Conn_Err_Size'Access); + + if Res /= 0 then + Conn_Err := Socket_Errno; + end if; + + else + Conn_Err := 0; + end if; + + -- Reset the socket to blocking I/O + + Req := (Name => Non_Blocking_IO, Enabled => False); + Control_Socket (Socket, Request => Req); + + -- Report error condition if any + + if Conn_Err /= 0 then + Raise_Socket_Error (Conn_Err); + end if; + end Connect_Socket; + + -------------------- + -- Control_Socket -- + -------------------- + + procedure Control_Socket + (Socket : Socket_Type; + Request : in out Request_Type) + is + Arg : aliased C.int; + Res : C.int; + + begin + case Request.Name is + when Non_Blocking_IO => + Arg := C.int (Boolean'Pos (Request.Enabled)); + + when N_Bytes_To_Read => + null; + end case; + + Res := Socket_Ioctl + (C.int (Socket), Requests (Request.Name), Arg'Unchecked_Access); + + if Res = Failure then + Raise_Socket_Error (Socket_Errno); + end if; + + case Request.Name is + when Non_Blocking_IO => + null; + + when N_Bytes_To_Read => + Request.Size := Natural (Arg); + end case; + end Control_Socket; + + ---------- + -- Copy -- + ---------- + + procedure Copy + (Source : Socket_Set_Type; + Target : out Socket_Set_Type) + is + begin + Target := Source; + end Copy; + + --------------------- + -- Create_Selector -- + --------------------- + + procedure Create_Selector (Selector : out Selector_Type) is + Two_Fds : aliased Fd_Pair; + Res : C.int; + + begin + if Is_Open (Selector) then + -- Raise exception to prevent socket descriptor leak + + raise Program_Error with "selector already open"; + end if; + + -- We open two signalling file descriptors. One of them is used to send + -- data to the other, which is included in a C_Select socket set. The + -- communication is used to force a call to C_Select to complete, and + -- the waiting task to resume its execution. + + Res := Signalling_Fds.Create (Two_Fds'Access); + + if Res = Failure then + Raise_Socket_Error (Socket_Errno); + end if; + + Selector.R_Sig_Socket := Socket_Type (Two_Fds (Read_End)); + Selector.W_Sig_Socket := Socket_Type (Two_Fds (Write_End)); + end Create_Selector; + + ------------------- + -- Create_Socket -- + ------------------- + + procedure Create_Socket + (Socket : out Socket_Type; + Family : Family_Type := Family_Inet; + Mode : Mode_Type := Socket_Stream) + is + Res : C.int; + + begin + Res := C_Socket (Families (Family), Modes (Mode), 0); + + if Res = Failure then + Raise_Socket_Error (Socket_Errno); + end if; + + Socket := Socket_Type (Res); + end Create_Socket; + + ----------- + -- Empty -- + ----------- + + procedure Empty (Item : out Socket_Set_Type) is + begin + Reset_Socket_Set (Item.Set'Access); + Item.Last := No_Socket; + end Empty; + + -------------------- + -- Err_Code_Image -- + -------------------- + + function Err_Code_Image (E : Integer) return String is + Msg : String := E'Img & "] "; + begin + Msg (Msg'First) := '['; + return Msg; + end Err_Code_Image; + + -------------- + -- Finalize -- + -------------- + + procedure Finalize (X : in out Sockets_Library_Controller) is + pragma Unreferenced (X); + + begin + -- Finalization operation for the GNAT.Sockets package + + Thin.Finalize; + end Finalize; + + -------------- + -- Finalize -- + -------------- + + procedure Finalize is + begin + -- This is a dummy placeholder for an obsolete API. + -- The real finalization actions are in Initialize primitive operation + -- of Sockets_Library_Controller. + + null; + end Finalize; + + --------- + -- Get -- + --------- + + procedure Get + (Item : in out Socket_Set_Type; + Socket : out Socket_Type) + is + S : aliased C.int; + L : aliased C.int := C.int (Item.Last); + + begin + if Item.Last /= No_Socket then + Get_Socket_From_Set + (Item.Set'Access, Last => L'Access, Socket => S'Access); + Item.Last := Socket_Type (L); + Socket := Socket_Type (S); + else + Socket := No_Socket; + end if; + end Get; + + ----------------- + -- Get_Address -- + ----------------- + + function Get_Address + (Stream : not null Stream_Access) return Sock_Addr_Type + is + begin + if Stream.all in Datagram_Socket_Stream_Type then + return Datagram_Socket_Stream_Type (Stream.all).From; + else + return Get_Peer_Name (Stream_Socket_Stream_Type (Stream.all).Socket); + end if; + end Get_Address; + + ------------------------- + -- Get_Host_By_Address -- + ------------------------- + + function Get_Host_By_Address + (Address : Inet_Addr_Type; + Family : Family_Type := Family_Inet) return Host_Entry_Type + is + pragma Unreferenced (Family); + + HA : aliased In_Addr := To_In_Addr (Address); + Buflen : constant C.int := Netdb_Buffer_Size; + Buf : aliased C.char_array (1 .. Netdb_Buffer_Size); + Res : aliased Hostent; + Err : aliased C.int; + + begin + Netdb_Lock; + + if C_Gethostbyaddr (HA'Address, HA'Size / 8, SOSC.AF_INET, + Res'Access, Buf'Address, Buflen, Err'Access) /= 0 + then + Netdb_Unlock; + Raise_Host_Error (Integer (Err), Image (Address)); + end if; + + begin + return H : constant Host_Entry_Type := + To_Host_Entry (Res'Unchecked_Access) + do + Netdb_Unlock; + end return; + exception + when others => + Netdb_Unlock; + raise; + end; + end Get_Host_By_Address; + + ---------------------- + -- Get_Host_By_Name -- + ---------------------- + + function Get_Host_By_Name (Name : String) return Host_Entry_Type is + begin + -- If the given name actually is the string representation of + -- an IP address, use Get_Host_By_Address instead. + + if Is_IP_Address (Name) then + return Get_Host_By_Address (Inet_Addr (Name)); + end if; + + declare + HN : constant C.char_array := C.To_C (Name); + Buflen : constant C.int := Netdb_Buffer_Size; + Buf : aliased C.char_array (1 .. Netdb_Buffer_Size); + Res : aliased Hostent; + Err : aliased C.int; + + begin + Netdb_Lock; + + if C_Gethostbyname + (HN, Res'Access, Buf'Address, Buflen, Err'Access) /= 0 + then + Netdb_Unlock; + Raise_Host_Error (Integer (Err), Name); + end if; + + return H : constant Host_Entry_Type := + To_Host_Entry (Res'Unchecked_Access) + do + Netdb_Unlock; + end return; + end; + end Get_Host_By_Name; + + ------------------- + -- Get_Peer_Name -- + ------------------- + + function Get_Peer_Name (Socket : Socket_Type) return Sock_Addr_Type is + Sin : aliased Sockaddr_In; + Len : aliased C.int := Sin'Size / 8; + Res : Sock_Addr_Type (Family_Inet); + + begin + if C_Getpeername (C.int (Socket), Sin'Address, Len'Access) = Failure then + Raise_Socket_Error (Socket_Errno); + end if; + + To_Inet_Addr (Sin.Sin_Addr, Res.Addr); + Res.Port := Port_Type (Network_To_Short (Sin.Sin_Port)); + + return Res; + end Get_Peer_Name; + + ------------------------- + -- Get_Service_By_Name -- + ------------------------- + + function Get_Service_By_Name + (Name : String; + Protocol : String) return Service_Entry_Type + is + SN : constant C.char_array := C.To_C (Name); + SP : constant C.char_array := C.To_C (Protocol); + Buflen : constant C.int := Netdb_Buffer_Size; + Buf : aliased C.char_array (1 .. Netdb_Buffer_Size); + Res : aliased Servent; + + begin + Netdb_Lock; + + if C_Getservbyname (SN, SP, Res'Access, Buf'Address, Buflen) /= 0 then + Netdb_Unlock; + raise Service_Error with "Service not found"; + end if; + + -- Translate from the C format to the API format + + return S : constant Service_Entry_Type := + To_Service_Entry (Res'Unchecked_Access) + do + Netdb_Unlock; + end return; + end Get_Service_By_Name; + + ------------------------- + -- Get_Service_By_Port -- + ------------------------- + + function Get_Service_By_Port + (Port : Port_Type; + Protocol : String) return Service_Entry_Type + is + SP : constant C.char_array := C.To_C (Protocol); + Buflen : constant C.int := Netdb_Buffer_Size; + Buf : aliased C.char_array (1 .. Netdb_Buffer_Size); + Res : aliased Servent; + + begin + Netdb_Lock; + + if C_Getservbyport + (C.int (Short_To_Network (C.unsigned_short (Port))), SP, + Res'Access, Buf'Address, Buflen) /= 0 + then + Netdb_Unlock; + raise Service_Error with "Service not found"; + end if; + + -- Translate from the C format to the API format + + return S : constant Service_Entry_Type := + To_Service_Entry (Res'Unchecked_Access) + do + Netdb_Unlock; + end return; + end Get_Service_By_Port; + + --------------------- + -- Get_Socket_Name -- + --------------------- + + function Get_Socket_Name + (Socket : Socket_Type) return Sock_Addr_Type + is + Sin : aliased Sockaddr_In; + Len : aliased C.int := Sin'Size / 8; + Res : C.int; + Addr : Sock_Addr_Type := No_Sock_Addr; + + begin + Res := C_Getsockname (C.int (Socket), Sin'Address, Len'Access); + + if Res /= Failure then + To_Inet_Addr (Sin.Sin_Addr, Addr.Addr); + Addr.Port := Port_Type (Network_To_Short (Sin.Sin_Port)); + end if; + + return Addr; + end Get_Socket_Name; + + ----------------------- + -- Get_Socket_Option -- + ----------------------- + + function Get_Socket_Option + (Socket : Socket_Type; + Level : Level_Type := Socket_Level; + Name : Option_Name; + Optname : Interfaces.C.int := -1) return Option_Type + is + use SOSC; + use type C.unsigned_char; + + V8 : aliased Two_Ints; + V4 : aliased C.int; + V1 : aliased C.unsigned_char; + VT : aliased Timeval; + Len : aliased C.int; + Add : System.Address; + Res : C.int; + Opt : Option_Type (Name); + Onm : Interfaces.C.int; + + begin + if Name in Specific_Option_Name then + Onm := Options (Name); + + elsif Optname = -1 then + raise Socket_Error with "optname must be specified"; + + else + Onm := Optname; + end if; + + case Name is + when Multicast_Loop + | Multicast_TTL + | Receive_Packet_Info + => + Len := V1'Size / 8; + Add := V1'Address; + + when Broadcast + | Busy_Polling + | Error + | Generic_Option + | Keep_Alive + | Multicast_If + | No_Delay + | Receive_Buffer + | Reuse_Address + | Send_Buffer + => + Len := V4'Size / 8; + Add := V4'Address; + + when Receive_Timeout + | Send_Timeout + => + -- The standard argument for SO_RCVTIMEO and SO_SNDTIMEO is a + -- struct timeval, but on Windows it is a milliseconds count in + -- a DWORD. + + if Target_OS = Windows then + Len := V4'Size / 8; + Add := V4'Address; + + else + Len := VT'Size / 8; + Add := VT'Address; + end if; + + when Add_Membership + | Drop_Membership + | Linger + => + Len := V8'Size / 8; + Add := V8'Address; + end case; + + Res := + C_Getsockopt + (C.int (Socket), + Levels (Level), + Onm, + Add, Len'Access); + + if Res = Failure then + Raise_Socket_Error (Socket_Errno); + end if; + + case Name is + when Generic_Option => + Opt.Optname := Onm; + Opt.Optval := V4; + + when Broadcast + | Keep_Alive + | No_Delay + | Reuse_Address + => + Opt.Enabled := (V4 /= 0); + + when Busy_Polling => + Opt.Microseconds := Natural (V4); + + when Linger => + Opt.Enabled := (V8 (V8'First) /= 0); + Opt.Seconds := Natural (V8 (V8'Last)); + + when Receive_Buffer + | Send_Buffer + => + Opt.Size := Natural (V4); + + when Error => + Opt.Error := Resolve_Error (Integer (V4)); + + when Add_Membership + | Drop_Membership + => + To_Inet_Addr (To_In_Addr (V8 (V8'First)), Opt.Multicast_Address); + To_Inet_Addr (To_In_Addr (V8 (V8'Last)), Opt.Local_Interface); + + when Multicast_If => + To_Inet_Addr (To_In_Addr (V4), Opt.Outgoing_If); + + when Multicast_TTL => + Opt.Time_To_Live := Integer (V1); + + when Multicast_Loop + | Receive_Packet_Info + => + Opt.Enabled := (V1 /= 0); + + when Receive_Timeout + | Send_Timeout + => + if Target_OS = Windows then + + -- Timeout is in milliseconds, actual value is 500 ms + + -- returned value (unless it is 0). + + if V4 = 0 then + Opt.Timeout := 0.0; + else + Opt.Timeout := Natural (V4) * 0.001 + 0.500; + end if; + + else + Opt.Timeout := To_Duration (VT); + end if; + end case; + + return Opt; + end Get_Socket_Option; + + --------------- + -- Host_Name -- + --------------- + + function Host_Name return String is + Name : aliased C.char_array (1 .. 64); + Res : C.int; + + begin + Res := C_Gethostname (Name'Address, Name'Length); + + if Res = Failure then + Raise_Socket_Error (Socket_Errno); + end if; + + return C.To_Ada (Name); + end Host_Name; + + ----------- + -- Image -- + ----------- + + function Image + (Val : Inet_Addr_VN_Type; + Hex : Boolean := False) return String + is + -- The largest Inet_Addr_Comp_Type image occurs with IPv4. It + -- has at most a length of 3 plus one '.' character. + + Buffer : String (1 .. 4 * Val'Length); + Length : Natural := 1; + Separator : Character; + + procedure Img10 (V : Inet_Addr_Comp_Type); + -- Append to Buffer image of V in decimal format + + procedure Img16 (V : Inet_Addr_Comp_Type); + -- Append to Buffer image of V in hexadecimal format + + ----------- + -- Img10 -- + ----------- + + procedure Img10 (V : Inet_Addr_Comp_Type) is + Img : constant String := V'Img; + Len : constant Natural := Img'Length - 1; + begin + Buffer (Length .. Length + Len - 1) := Img (2 .. Img'Last); + Length := Length + Len; + end Img10; + + ----------- + -- Img16 -- + ----------- + + procedure Img16 (V : Inet_Addr_Comp_Type) is + begin + Buffer (Length) := Hex_To_Char (Natural (V / 16) + 1); + Buffer (Length + 1) := Hex_To_Char (Natural (V mod 16) + 1); + Length := Length + 2; + end Img16; + + -- Start of processing for Image + + begin + Separator := (if Hex then ':' else '.'); + + for J in Val'Range loop + if Hex then + Img16 (Val (J)); + else + Img10 (Val (J)); + end if; + + if J /= Val'Last then + Buffer (Length) := Separator; + Length := Length + 1; + end if; + end loop; + + return Buffer (1 .. Length - 1); + end Image; + + ----------- + -- Image -- + ----------- + + function Image (Value : Inet_Addr_Type) return String is + begin + if Value.Family = Family_Inet then + return Image (Inet_Addr_VN_Type (Value.Sin_V4), Hex => False); + else + return Image (Inet_Addr_VN_Type (Value.Sin_V6), Hex => True); + end if; + end Image; + + ----------- + -- Image -- + ----------- + + function Image (Value : Sock_Addr_Type) return String is + Port : constant String := Value.Port'Img; + begin + return Image (Value.Addr) & ':' & Port (2 .. Port'Last); + end Image; + + ----------- + -- Image -- + ----------- + + function Image (Socket : Socket_Type) return String is + begin + return Socket'Img; + end Image; + + ----------- + -- Image -- + ----------- + + function Image (Item : Socket_Set_Type) return String is + Socket_Set : Socket_Set_Type := Item; + + begin + declare + Last_Img : constant String := Socket_Set.Last'Img; + Buffer : String + (1 .. (Integer (Socket_Set.Last) + 1) * Last_Img'Length); + Index : Positive := 1; + Socket : Socket_Type; + + begin + while not Is_Empty (Socket_Set) loop + Get (Socket_Set, Socket); + + declare + Socket_Img : constant String := Socket'Img; + begin + Buffer (Index .. Index + Socket_Img'Length - 1) := Socket_Img; + Index := Index + Socket_Img'Length; + end; + end loop; + + return "[" & Last_Img & "]" & Buffer (1 .. Index - 1); + end; + end Image; + + --------------- + -- Inet_Addr -- + --------------- + + function Inet_Addr (Image : String) return Inet_Addr_Type is + use Interfaces.C; + + Img : aliased char_array := To_C (Image); + Addr : aliased C.int; + Res : C.int; + Result : Inet_Addr_Type; + + begin + -- Special case for an empty Image as on some platforms (e.g. Windows) + -- calling Inet_Addr("") will not return an error. + + if Image = "" then + Raise_Socket_Error (SOSC.EINVAL); + end if; + + Res := Inet_Pton (SOSC.AF_INET, Img'Address, Addr'Address); + + if Res < 0 then + Raise_Socket_Error (Socket_Errno); + + elsif Res = 0 then + Raise_Socket_Error (SOSC.EINVAL); + end if; + + To_Inet_Addr (To_In_Addr (Addr), Result); + return Result; + end Inet_Addr; + + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize (X : in out Sockets_Library_Controller) is + pragma Unreferenced (X); + + begin + Thin.Initialize; + end Initialize; + + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize (Process_Blocking_IO : Boolean) is + Expected : constant Boolean := not SOSC.Thread_Blocking_IO; + + begin + if Process_Blocking_IO /= Expected then + raise Socket_Error with + "incorrect Process_Blocking_IO setting, expected " & Expected'Img; + end if; + + -- This is a dummy placeholder for an obsolete API + + -- Real initialization actions are in Initialize primitive operation + -- of Sockets_Library_Controller. + + null; + end Initialize; + + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize is + begin + -- This is a dummy placeholder for an obsolete API + + -- Real initialization actions are in Initialize primitive operation + -- of Sockets_Library_Controller. + + null; + end Initialize; + + -------------- + -- Is_Empty -- + -------------- + + function Is_Empty (Item : Socket_Set_Type) return Boolean is + begin + return Item.Last = No_Socket; + end Is_Empty; + + ------------------- + -- Is_IP_Address -- + ------------------- + + function Is_IP_Address (Name : String) return Boolean is + Dots : Natural := 0; + + begin + -- Perform a cursory check for a dotted quad: we must have 1 to 3 dots, + -- and there must be at least one digit around each. + + for J in Name'Range loop + if Name (J) = '.' then + + -- Check that the dot is not in first or last position, and that + -- it is followed by a digit. Note that we already know that it is + -- preceded by a digit, or we would have returned earlier on. + + if J in Name'First + 1 .. Name'Last - 1 + and then Name (J + 1) in '0' .. '9' + then + Dots := Dots + 1; + + -- Definitely not a proper dotted quad + + else + return False; + end if; + + elsif Name (J) not in '0' .. '9' then + return False; + end if; + end loop; + + return Dots in 1 .. 3; + end Is_IP_Address; + + ------------- + -- Is_Open -- + ------------- + + function Is_Open (S : Selector_Type) return Boolean is + begin + if S.Is_Null then + return True; + + else + -- Either both controlling socket descriptors are valid (case of an + -- open selector) or neither (case of a closed selector). + + pragma Assert ((S.R_Sig_Socket /= No_Socket) + = + (S.W_Sig_Socket /= No_Socket)); + + return S.R_Sig_Socket /= No_Socket; + end if; + end Is_Open; + + ------------ + -- Is_Set -- + ------------ + + function Is_Set + (Item : Socket_Set_Type; + Socket : Socket_Type) return Boolean + is + begin + Check_For_Fd_Set (Socket); + + return Item.Last /= No_Socket + and then Socket <= Item.Last + and then Is_Socket_In_Set (Item.Set'Access, C.int (Socket)) /= 0; + end Is_Set; + + ------------------- + -- Listen_Socket -- + ------------------- + + procedure Listen_Socket + (Socket : Socket_Type; + Length : Natural := 15) + is + Res : constant C.int := C_Listen (C.int (Socket), C.int (Length)); + begin + if Res = Failure then + Raise_Socket_Error (Socket_Errno); + end if; + end Listen_Socket; + + ------------ + -- Narrow -- + ------------ + + procedure Narrow (Item : in out Socket_Set_Type) is + Last : aliased C.int := C.int (Item.Last); + begin + if Item.Last /= No_Socket then + Last_Socket_In_Set (Item.Set'Access, Last'Unchecked_Access); + Item.Last := Socket_Type (Last); + end if; + end Narrow; + + ---------------- + -- Netdb_Lock -- + ---------------- + + procedure Netdb_Lock is + begin + if Need_Netdb_Lock then + System.Task_Lock.Lock; + end if; + end Netdb_Lock; + + ------------------ + -- Netdb_Unlock -- + ------------------ + + procedure Netdb_Unlock is + begin + if Need_Netdb_Lock then + System.Task_Lock.Unlock; + end if; + end Netdb_Unlock; + + -------------------------------- + -- Normalize_Empty_Socket_Set -- + -------------------------------- + + procedure Normalize_Empty_Socket_Set (S : in out Socket_Set_Type) is + begin + if S.Last = No_Socket then + Reset_Socket_Set (S.Set'Access); + end if; + end Normalize_Empty_Socket_Set; + + ------------------- + -- Official_Name -- + ------------------- + + function Official_Name (E : Host_Entry_Type) return String is + begin + return To_String (E.Official); + end Official_Name; + + ------------------- + -- Official_Name -- + ------------------- + + function Official_Name (S : Service_Entry_Type) return String is + begin + return To_String (S.Official); + end Official_Name; + + -------------------- + -- Wait_On_Socket -- + -------------------- + + procedure Wait_On_Socket + (Socket : Socket_Type; + For_Read : Boolean; + Timeout : Selector_Duration; + Selector : access Selector_Type := null; + Status : out Selector_Status) + is + type Local_Selector_Access is access Selector_Type; + for Local_Selector_Access'Storage_Size use Selector_Type'Size; + + S : Selector_Access; + -- Selector to use for waiting + + R_Fd_Set : Socket_Set_Type; + W_Fd_Set : Socket_Set_Type; + + begin + -- Create selector if not provided by the user + + if Selector = null then + declare + Local_S : constant Local_Selector_Access := new Selector_Type; + begin + S := Local_S.all'Unchecked_Access; + Create_Selector (S.all); + end; + + else + S := Selector.all'Access; + end if; + + if For_Read then + Set (R_Fd_Set, Socket); + else + Set (W_Fd_Set, Socket); + end if; + + Check_Selector (S.all, R_Fd_Set, W_Fd_Set, Status, Timeout); + + if Selector = null then + Close_Selector (S.all); + end if; + end Wait_On_Socket; + + ----------------- + -- Port_Number -- + ----------------- + + function Port_Number (S : Service_Entry_Type) return Port_Type is + begin + return S.Port; + end Port_Number; + + ------------------- + -- Protocol_Name -- + ------------------- + + function Protocol_Name (S : Service_Entry_Type) return String is + begin + return To_String (S.Protocol); + end Protocol_Name; + + ---------------------- + -- Raise_Host_Error -- + ---------------------- + + procedure Raise_Host_Error (H_Error : Integer; Name : String) is + function Dedot (Value : String) return String is + (if Value /= "" and then Value (Value'Last) = '.' then + Value (Value'First .. Value'Last - 1) + else + Value); + -- Removes dot at the end of error message + + begin + raise Host_Error with + Err_Code_Image (H_Error) + & Dedot (Host_Error_Messages.Host_Error_Message (H_Error)) + & ": " & Name; + end Raise_Host_Error; + + ------------------------ + -- Raise_Socket_Error -- + ------------------------ + + procedure Raise_Socket_Error (Error : Integer) is + begin + raise Socket_Error with + Err_Code_Image (Error) & Socket_Error_Message (Error); + end Raise_Socket_Error; + + ---------- + -- Read -- + ---------- + + procedure Read + (Stream : in out Datagram_Socket_Stream_Type; + Item : out Ada.Streams.Stream_Element_Array; + Last : out Ada.Streams.Stream_Element_Offset) + is + begin + Receive_Socket + (Stream.Socket, + Item, + Last, + Stream.From); + end Read; + + ---------- + -- Read -- + ---------- + + procedure Read + (Stream : in out Stream_Socket_Stream_Type; + Item : out Ada.Streams.Stream_Element_Array; + Last : out Ada.Streams.Stream_Element_Offset) + is + First : Ada.Streams.Stream_Element_Offset := Item'First; + Index : Ada.Streams.Stream_Element_Offset := First - 1; + Max : constant Ada.Streams.Stream_Element_Offset := Item'Last; + + begin + loop + Receive_Socket (Stream.Socket, Item (First .. Max), Index); + Last := Index; + + -- Exit when all or zero data received. Zero means that the socket + -- peer is closed. + + exit when Index < First or else Index = Max; + + First := Index + 1; + end loop; + end Read; + + -------------------- + -- Receive_Socket -- + -------------------- + + procedure Receive_Socket + (Socket : Socket_Type; + Item : out Ada.Streams.Stream_Element_Array; + Last : out Ada.Streams.Stream_Element_Offset; + Flags : Request_Flag_Type := No_Request_Flag) + is + Res : C.int; + + begin + Res := + C_Recv (C.int (Socket), Item'Address, Item'Length, To_Int (Flags)); + + if Res = Failure then + Raise_Socket_Error (Socket_Errno); + end if; + + Last := Last_Index (First => Item'First, Count => size_t (Res)); + end Receive_Socket; + + -------------------- + -- Receive_Socket -- + -------------------- + + procedure Receive_Socket + (Socket : Socket_Type; + Item : out Ada.Streams.Stream_Element_Array; + Last : out Ada.Streams.Stream_Element_Offset; + From : out Sock_Addr_Type; + Flags : Request_Flag_Type := No_Request_Flag) + is + Res : C.int; + Sin : aliased Sockaddr_In; + Len : aliased C.int := Sin'Size / 8; + + begin + Res := + C_Recvfrom + (C.int (Socket), + Item'Address, + Item'Length, + To_Int (Flags), + Sin'Address, + Len'Access); + + if Res = Failure then + Raise_Socket_Error (Socket_Errno); + end if; + + Last := Last_Index (First => Item'First, Count => size_t (Res)); + + To_Inet_Addr (Sin.Sin_Addr, From.Addr); + From.Port := Port_Type (Network_To_Short (Sin.Sin_Port)); + end Receive_Socket; + + -------------------- + -- Receive_Vector -- + -------------------- + + procedure Receive_Vector + (Socket : Socket_Type; + Vector : Vector_Type; + Count : out Ada.Streams.Stream_Element_Count; + Flags : Request_Flag_Type := No_Request_Flag) + is + Res : ssize_t; + + Msg : Msghdr := + (Msg_Name => System.Null_Address, + Msg_Namelen => 0, + Msg_Iov => Vector'Address, + + -- recvmsg(2) returns EMSGSIZE on Linux (and probably on other + -- platforms) when the supplied vector is longer than IOV_MAX, + -- so use minimum of the two lengths. + + Msg_Iovlen => SOSC.Msg_Iovlen_T'Min + (Vector'Length, SOSC.IOV_MAX), + + Msg_Control => System.Null_Address, + Msg_Controllen => 0, + Msg_Flags => 0); + + begin + Res := + C_Recvmsg + (C.int (Socket), + Msg'Address, + To_Int (Flags)); + + if Res = ssize_t (Failure) then + Raise_Socket_Error (Socket_Errno); + end if; + + Count := Ada.Streams.Stream_Element_Count (Res); + end Receive_Vector; + + ------------------- + -- Resolve_Error -- + ------------------- + + function Resolve_Error + (Error_Value : Integer; + From_Errno : Boolean := True) return Error_Type + is + use GNAT.Sockets.SOSC; + + begin + if not From_Errno then + case Error_Value is + when SOSC.HOST_NOT_FOUND => return Unknown_Host; + when SOSC.TRY_AGAIN => return Host_Name_Lookup_Failure; + when SOSC.NO_RECOVERY => return Non_Recoverable_Error; + when SOSC.NO_DATA => return Unknown_Server_Error; + when others => return Cannot_Resolve_Error; + end case; + end if; + + -- Special case: EAGAIN may be the same value as EWOULDBLOCK, so we + -- can't include it in the case statement below. + + pragma Warnings (Off); + -- Condition "EAGAIN /= EWOULDBLOCK" is known at compile time + + if EAGAIN /= EWOULDBLOCK and then Error_Value = EAGAIN then + return Resource_Temporarily_Unavailable; + end if; + + -- This is not a case statement because if a particular error + -- number constant is not defined, s-oscons-tmplt.c defines + -- it to -1. If multiple constants are not defined, they + -- would each be -1 and result in a "duplicate value in case" error. + -- + -- But we have to leave warnings off because the compiler is also + -- smart enough to note that when two errnos have the same value, + -- the second if condition is useless. + if Error_Value = ENOERROR then + return Success; + elsif Error_Value = EACCES then + return Permission_Denied; + elsif Error_Value = EADDRINUSE then + return Address_Already_In_Use; + elsif Error_Value = EADDRNOTAVAIL then + return Cannot_Assign_Requested_Address; + elsif Error_Value = EAFNOSUPPORT then + return Address_Family_Not_Supported_By_Protocol; + elsif Error_Value = EALREADY then + return Operation_Already_In_Progress; + elsif Error_Value = EBADF then + return Bad_File_Descriptor; + elsif Error_Value = ECONNABORTED then + return Software_Caused_Connection_Abort; + elsif Error_Value = ECONNREFUSED then + return Connection_Refused; + elsif Error_Value = ECONNRESET then + return Connection_Reset_By_Peer; + elsif Error_Value = EDESTADDRREQ then + return Destination_Address_Required; + elsif Error_Value = EFAULT then + return Bad_Address; + elsif Error_Value = EHOSTDOWN then + return Host_Is_Down; + elsif Error_Value = EHOSTUNREACH then + return No_Route_To_Host; + elsif Error_Value = EINPROGRESS then + return Operation_Now_In_Progress; + elsif Error_Value = EINTR then + return Interrupted_System_Call; + elsif Error_Value = EINVAL then + return Invalid_Argument; + elsif Error_Value = EIO then + return Input_Output_Error; + elsif Error_Value = EISCONN then + return Transport_Endpoint_Already_Connected; + elsif Error_Value = ELOOP then + return Too_Many_Symbolic_Links; + elsif Error_Value = EMFILE then + return Too_Many_Open_Files; + elsif Error_Value = EMSGSIZE then + return Message_Too_Long; + elsif Error_Value = ENAMETOOLONG then + return File_Name_Too_Long; + elsif Error_Value = ENETDOWN then + return Network_Is_Down; + elsif Error_Value = ENETRESET then + return Network_Dropped_Connection_Because_Of_Reset; + elsif Error_Value = ENETUNREACH then + return Network_Is_Unreachable; + elsif Error_Value = ENOBUFS then + return No_Buffer_Space_Available; + elsif Error_Value = ENOPROTOOPT then + return Protocol_Not_Available; + elsif Error_Value = ENOTCONN then + return Transport_Endpoint_Not_Connected; + elsif Error_Value = ENOTSOCK then + return Socket_Operation_On_Non_Socket; + elsif Error_Value = EOPNOTSUPP then + return Operation_Not_Supported; + elsif Error_Value = EPFNOSUPPORT then + return Protocol_Family_Not_Supported; + elsif Error_Value = EPIPE then + return Broken_Pipe; + elsif Error_Value = EPROTONOSUPPORT then + return Protocol_Not_Supported; + elsif Error_Value = EPROTOTYPE then + return Protocol_Wrong_Type_For_Socket; + elsif Error_Value = ESHUTDOWN then + return Cannot_Send_After_Transport_Endpoint_Shutdown; + elsif Error_Value = ESOCKTNOSUPPORT then + return Socket_Type_Not_Supported; + elsif Error_Value = ETIMEDOUT then + return Connection_Timed_Out; + elsif Error_Value = ETOOMANYREFS then + return Too_Many_References; + elsif Error_Value = EWOULDBLOCK then + return Resource_Temporarily_Unavailable; + else + return Cannot_Resolve_Error; + end if; + pragma Warnings (On); + + end Resolve_Error; + + ----------------------- + -- Resolve_Exception -- + ----------------------- + + function Resolve_Exception + (Occurrence : Exception_Occurrence) return Error_Type + is + Id : constant Exception_Id := Exception_Identity (Occurrence); + Msg : constant String := Exception_Message (Occurrence); + First : Natural; + Last : Natural; + Val : Integer; + + begin + First := Msg'First; + while First <= Msg'Last + and then Msg (First) not in '0' .. '9' + loop + First := First + 1; + end loop; + + if First > Msg'Last then + return Cannot_Resolve_Error; + end if; + + Last := First; + while Last < Msg'Last + and then Msg (Last + 1) in '0' .. '9' + loop + Last := Last + 1; + end loop; + + Val := Integer'Value (Msg (First .. Last)); + + if Id = Socket_Error_Id then + return Resolve_Error (Val); + + elsif Id = Host_Error_Id then + return Resolve_Error (Val, False); + + else + return Cannot_Resolve_Error; + end if; + end Resolve_Exception; + + ----------------- + -- Send_Socket -- + ----------------- + + procedure Send_Socket + (Socket : Socket_Type; + Item : Ada.Streams.Stream_Element_Array; + Last : out Ada.Streams.Stream_Element_Offset; + Flags : Request_Flag_Type := No_Request_Flag) + is + begin + Send_Socket (Socket, Item, Last, To => null, Flags => Flags); + end Send_Socket; + + ----------------- + -- Send_Socket -- + ----------------- + + procedure Send_Socket + (Socket : Socket_Type; + Item : Ada.Streams.Stream_Element_Array; + Last : out Ada.Streams.Stream_Element_Offset; + To : Sock_Addr_Type; + Flags : Request_Flag_Type := No_Request_Flag) + is + begin + Send_Socket + (Socket, Item, Last, To => To'Unrestricted_Access, Flags => Flags); + end Send_Socket; + + ----------------- + -- Send_Socket -- + ----------------- + + procedure Send_Socket + (Socket : Socket_Type; + Item : Ada.Streams.Stream_Element_Array; + Last : out Ada.Streams.Stream_Element_Offset; + To : access Sock_Addr_Type; + Flags : Request_Flag_Type := No_Request_Flag) + is + Res : C.int; + + Sin : aliased Sockaddr_In; + C_To : System.Address; + Len : C.int; + + begin + if To /= null then + Set_Family (Sin.Sin_Family, To.Family); + Set_Address (Sin'Unchecked_Access, To_In_Addr (To.Addr)); + Set_Port + (Sin'Unchecked_Access, + Short_To_Network (C.unsigned_short (To.Port))); + C_To := Sin'Address; + Len := Sin'Size / 8; + + else + C_To := System.Null_Address; + Len := 0; + end if; + + Res := C_Sendto + (C.int (Socket), + Item'Address, + Item'Length, + Set_Forced_Flags (To_Int (Flags)), + C_To, + Len); + + if Res = Failure then + Raise_Socket_Error (Socket_Errno); + end if; + + Last := Last_Index (First => Item'First, Count => size_t (Res)); + end Send_Socket; + + ----------------- + -- Send_Vector -- + ----------------- + + procedure Send_Vector + (Socket : Socket_Type; + Vector : Vector_Type; + Count : out Ada.Streams.Stream_Element_Count; + Flags : Request_Flag_Type := No_Request_Flag) + is + use SOSC; + use Interfaces.C; + + Res : ssize_t; + Iov_Count : SOSC.Msg_Iovlen_T; + This_Iov_Count : SOSC.Msg_Iovlen_T; + Msg : Msghdr; + + begin + Count := 0; + Iov_Count := 0; + while Iov_Count < Vector'Length loop + + pragma Warnings (Off); + -- Following test may be compile time known on some targets + + This_Iov_Count := + (if Vector'Length - Iov_Count > SOSC.IOV_MAX + then SOSC.IOV_MAX + else Vector'Length - Iov_Count); + + pragma Warnings (On); + + Msg := + (Msg_Name => System.Null_Address, + Msg_Namelen => 0, + Msg_Iov => Vector + (Vector'First + Integer (Iov_Count))'Address, + Msg_Iovlen => This_Iov_Count, + Msg_Control => System.Null_Address, + Msg_Controllen => 0, + Msg_Flags => 0); + + Res := + C_Sendmsg + (C.int (Socket), + Msg'Address, + Set_Forced_Flags (To_Int (Flags))); + + if Res = ssize_t (Failure) then + Raise_Socket_Error (Socket_Errno); + end if; + + Count := Count + Ada.Streams.Stream_Element_Count (Res); + Iov_Count := Iov_Count + This_Iov_Count; + end loop; + end Send_Vector; + + --------- + -- Set -- + --------- + + procedure Set (Item : in out Socket_Set_Type; Socket : Socket_Type) is + begin + Check_For_Fd_Set (Socket); + + if Item.Last = No_Socket then + + -- Uninitialized socket set, make sure it is properly zeroed out + + Reset_Socket_Set (Item.Set'Access); + Item.Last := Socket; + + elsif Item.Last < Socket then + Item.Last := Socket; + end if; + + Insert_Socket_In_Set (Item.Set'Access, C.int (Socket)); + end Set; + + ----------------------- + -- Set_Close_On_Exec -- + ----------------------- + + procedure Set_Close_On_Exec + (Socket : Socket_Type; + Close_On_Exec : Boolean; + Status : out Boolean) + is + function C_Set_Close_On_Exec + (Socket : Socket_Type; Close_On_Exec : C.int) return C.int; + pragma Import (C, C_Set_Close_On_Exec, "__gnat_set_close_on_exec"); + begin + Status := C_Set_Close_On_Exec (Socket, Boolean'Pos (Close_On_Exec)) = 0; + end Set_Close_On_Exec; + + ---------------------- + -- Set_Forced_Flags -- + ---------------------- + + function Set_Forced_Flags (F : C.int) return C.int is + use type C.unsigned; + function To_unsigned is + new Ada.Unchecked_Conversion (C.int, C.unsigned); + function To_int is + new Ada.Unchecked_Conversion (C.unsigned, C.int); + begin + return To_int (To_unsigned (F) or SOSC.MSG_Forced_Flags); + end Set_Forced_Flags; + + ----------------------- + -- Set_Socket_Option -- + ----------------------- + + procedure Set_Socket_Option + (Socket : Socket_Type; + Level : Level_Type := Socket_Level; + Option : Option_Type) + is + use SOSC; + + V8 : aliased Two_Ints; + V4 : aliased C.int; + V1 : aliased C.unsigned_char; + VT : aliased Timeval; + Len : C.int; + Add : System.Address := Null_Address; + Res : C.int; + Onm : C.int; + + begin + case Option.Name is + when Generic_Option => + V4 := Option.Optval; + Len := V4'Size / 8; + Add := V4'Address; + + when Broadcast + | Keep_Alive + | No_Delay + | Reuse_Address + => + V4 := C.int (Boolean'Pos (Option.Enabled)); + Len := V4'Size / 8; + Add := V4'Address; + + when Busy_Polling => + V4 := C.int (Option.Microseconds); + Len := V4'Size / 8; + Add := V4'Address; + + when Linger => + V8 (V8'First) := C.int (Boolean'Pos (Option.Enabled)); + V8 (V8'Last) := C.int (Option.Seconds); + Len := V8'Size / 8; + Add := V8'Address; + + when Receive_Buffer + | Send_Buffer + => + V4 := C.int (Option.Size); + Len := V4'Size / 8; + Add := V4'Address; + + when Error => + V4 := C.int (Boolean'Pos (True)); + Len := V4'Size / 8; + Add := V4'Address; + + when Add_Membership + | Drop_Membership + => + V8 (V8'First) := To_Int (To_In_Addr (Option.Multicast_Address)); + V8 (V8'Last) := To_Int (To_In_Addr (Option.Local_Interface)); + Len := V8'Size / 8; + Add := V8'Address; + + when Multicast_If => + V4 := To_Int (To_In_Addr (Option.Outgoing_If)); + Len := V4'Size / 8; + Add := V4'Address; + + when Multicast_TTL => + V1 := C.unsigned_char (Option.Time_To_Live); + Len := V1'Size / 8; + Add := V1'Address; + + when Multicast_Loop + | Receive_Packet_Info + => + V1 := C.unsigned_char (Boolean'Pos (Option.Enabled)); + Len := V1'Size / 8; + Add := V1'Address; + + when Receive_Timeout + | Send_Timeout + => + if Target_OS = Windows then + + -- On Windows, the timeout is a DWORD in milliseconds, and + -- the actual timeout is 500 ms + the given value (unless it + -- is 0). + + V4 := C.int (Option.Timeout / 0.001); + + if V4 > 500 then + V4 := V4 - 500; + + elsif V4 > 0 then + V4 := 1; + end if; + + Len := V4'Size / 8; + Add := V4'Address; + + else + VT := To_Timeval (Option.Timeout); + Len := VT'Size / 8; + Add := VT'Address; + end if; + end case; + + if Option.Name in Specific_Option_Name then + Onm := Options (Option.Name); + + elsif Option.Optname = -1 then + raise Socket_Error with "optname must be specified"; + + else + Onm := Option.Optname; + end if; + + Res := C_Setsockopt + (C.int (Socket), + Levels (Level), + Onm, + Add, Len); + + if Res = Failure then + Raise_Socket_Error (Socket_Errno); + end if; + end Set_Socket_Option; + + ---------------------- + -- Short_To_Network -- + ---------------------- + + function Short_To_Network (S : C.unsigned_short) return C.unsigned_short is + use type C.unsigned_short; + + begin + -- Big-endian case. No conversion needed. On these platforms, htons() + -- defaults to a null procedure. + + if Default_Bit_Order = High_Order_First then + return S; + + -- Little-endian case. We must swap the high and low bytes of this + -- short to make the port number network compliant. + + else + return (S / 256) + (S mod 256) * 256; + end if; + end Short_To_Network; + + --------------------- + -- Shutdown_Socket -- + --------------------- + + procedure Shutdown_Socket + (Socket : Socket_Type; + How : Shutmode_Type := Shut_Read_Write) + is + Res : C.int; + + begin + Res := C_Shutdown (C.int (Socket), Shutmodes (How)); + + if Res = Failure then + Raise_Socket_Error (Socket_Errno); + end if; + end Shutdown_Socket; + + ------------ + -- Stream -- + ------------ + + function Stream + (Socket : Socket_Type; + Send_To : Sock_Addr_Type) return Stream_Access + is + S : Datagram_Socket_Stream_Access; + + begin + S := new Datagram_Socket_Stream_Type; + S.Socket := Socket; + S.To := Send_To; + S.From := Get_Socket_Name (Socket); + return Stream_Access (S); + end Stream; + + ------------ + -- Stream -- + ------------ + + function Stream (Socket : Socket_Type) return Stream_Access is + S : Stream_Socket_Stream_Access; + begin + S := new Stream_Socket_Stream_Type; + S.Socket := Socket; + return Stream_Access (S); + end Stream; + + ------------ + -- To_Ada -- + ------------ + + function To_Ada (Fd : Integer) return Socket_Type is + begin + return Socket_Type (Fd); + end To_Ada; + + ---------- + -- To_C -- + ---------- + + function To_C (Socket : Socket_Type) return Integer is + begin + return Integer (Socket); + end To_C; + + ----------------- + -- To_Duration -- + ----------------- + + function To_Duration (Val : Timeval) return Timeval_Duration is + begin + return Natural (Val.Tv_Sec) * 1.0 + Natural (Val.Tv_Usec) * 1.0E-6; + end To_Duration; + + ------------------- + -- To_Host_Entry -- + ------------------- + + function To_Host_Entry (E : Hostent_Access) return Host_Entry_Type is + use type C.size_t; + + Aliases_Count, Addresses_Count : Natural; + + -- H_Length is not used because it is currently only ever set to 4, as + -- we only handle the case of H_Addrtype being AF_INET. + + begin + if Hostent_H_Addrtype (E) /= SOSC.AF_INET then + Raise_Socket_Error (SOSC.EPFNOSUPPORT); + end if; + + Aliases_Count := 0; + while Hostent_H_Alias (E, C.int (Aliases_Count)) /= Null_Address loop + Aliases_Count := Aliases_Count + 1; + end loop; + + Addresses_Count := 0; + while Hostent_H_Addr (E, C.int (Addresses_Count)) /= Null_Address loop + Addresses_Count := Addresses_Count + 1; + end loop; + + return Result : Host_Entry_Type + (Aliases_Length => Aliases_Count, + Addresses_Length => Addresses_Count) + do + Result.Official := To_Name (Value (Hostent_H_Name (E))); + + for J in Result.Aliases'Range loop + Result.Aliases (J) := + To_Name (Value (Hostent_H_Alias + (E, C.int (J - Result.Aliases'First)))); + end loop; + + for J in Result.Addresses'Range loop + declare + Addr : In_Addr; + + -- Hostent_H_Addr (E, <index>) may return an address that is + -- not correctly aligned for In_Addr, so we need to use + -- an intermediate copy operation on a type with an alignment + -- of 1 to recover the value. + + subtype Addr_Buf_T is C.char_array (1 .. Addr'Size / 8); + Unaligned_Addr : Addr_Buf_T; + for Unaligned_Addr'Address + use Hostent_H_Addr (E, C.int (J - Result.Addresses'First)); + pragma Import (Ada, Unaligned_Addr); + + Aligned_Addr : Addr_Buf_T; + for Aligned_Addr'Address use Addr'Address; + pragma Import (Ada, Aligned_Addr); + + begin + Aligned_Addr := Unaligned_Addr; + To_Inet_Addr (Addr, Result.Addresses (J)); + end; + end loop; + end return; + end To_Host_Entry; + + ---------------- + -- To_In_Addr -- + ---------------- + + function To_In_Addr (Addr : Inet_Addr_Type) return In_Addr is + begin + if Addr.Family = Family_Inet then + return (S_B1 => C.unsigned_char (Addr.Sin_V4 (1)), + S_B2 => C.unsigned_char (Addr.Sin_V4 (2)), + S_B3 => C.unsigned_char (Addr.Sin_V4 (3)), + S_B4 => C.unsigned_char (Addr.Sin_V4 (4))); + end if; + + raise Socket_Error with "IPv6 not supported"; + end To_In_Addr; + + ------------------ + -- To_Inet_Addr -- + ------------------ + + procedure To_Inet_Addr + (Addr : In_Addr; + Result : out Inet_Addr_Type) is + begin + Result.Sin_V4 (1) := Inet_Addr_Comp_Type (Addr.S_B1); + Result.Sin_V4 (2) := Inet_Addr_Comp_Type (Addr.S_B2); + Result.Sin_V4 (3) := Inet_Addr_Comp_Type (Addr.S_B3); + Result.Sin_V4 (4) := Inet_Addr_Comp_Type (Addr.S_B4); + end To_Inet_Addr; + + ------------ + -- To_Int -- + ------------ + + function To_Int (F : Request_Flag_Type) return C.int + is + Current : Request_Flag_Type := F; + Result : C.int := 0; + + begin + for J in Flags'Range loop + exit when Current = 0; + + if Current mod 2 /= 0 then + if Flags (J) = -1 then + Raise_Socket_Error (SOSC.EOPNOTSUPP); + end if; + + Result := Result + Flags (J); + end if; + + Current := Current / 2; + end loop; + + return Result; + end To_Int; + + ------------- + -- To_Name -- + ------------- + + function To_Name (N : String) return Name_Type is + begin + return Name_Type'(N'Length, N); + end To_Name; + + ---------------------- + -- To_Service_Entry -- + ---------------------- + + function To_Service_Entry (E : Servent_Access) return Service_Entry_Type is + Aliases_Count : Natural; + + begin + Aliases_Count := 0; + while Servent_S_Alias (E, C.int (Aliases_Count)) /= Null_Address loop + Aliases_Count := Aliases_Count + 1; + end loop; + + return Result : Service_Entry_Type (Aliases_Length => Aliases_Count) do + Result.Official := To_Name (Value (Servent_S_Name (E))); + + for J in Result.Aliases'Range loop + Result.Aliases (J) := + To_Name (Value (Servent_S_Alias + (E, C.int (J - Result.Aliases'First)))); + end loop; + + Result.Protocol := To_Name (Value (Servent_S_Proto (E))); + Result.Port := + Port_Type (Network_To_Short (Servent_S_Port (E))); + end return; + end To_Service_Entry; + + --------------- + -- To_String -- + --------------- + + function To_String (HN : Name_Type) return String is + begin + return HN.Name (1 .. HN.Length); + end To_String; + + ---------------- + -- To_Timeval -- + ---------------- + + function To_Timeval (Val : Timeval_Duration) return Timeval is + S : time_t; + uS : suseconds_t; + + begin + -- If zero, set result as zero (otherwise it gets rounded down to -1) + + if Val = 0.0 then + S := 0; + uS := 0; + + -- Normal case where we do round down + + else + S := time_t (Val - 0.5); + uS := suseconds_t (1_000_000 * (Val - Selector_Duration (S))); + end if; + + return (S, uS); + end To_Timeval; + + ----------- + -- Value -- + ----------- + + function Value (S : System.Address) return String is + Str : String (1 .. Positive'Last); + for Str'Address use S; + pragma Import (Ada, Str); + + Terminator : Positive := Str'First; + + begin + while Str (Terminator) /= ASCII.NUL loop + Terminator := Terminator + 1; + end loop; + + return Str (1 .. Terminator - 1); + end Value; + + ----------- + -- Write -- + ----------- + + procedure Write + (Stream : in out Datagram_Socket_Stream_Type; + Item : Ada.Streams.Stream_Element_Array) + is + Last : Stream_Element_Offset; + + begin + Send_Socket + (Stream.Socket, + Item, + Last, + Stream.To); + + -- It is an error if not all of the data has been sent + + if Last /= Item'Last then + Raise_Socket_Error (Socket_Errno); + end if; + end Write; + + ----------- + -- Write -- + ----------- + + procedure Write + (Stream : in out Stream_Socket_Stream_Type; + Item : Ada.Streams.Stream_Element_Array) + is + First : Ada.Streams.Stream_Element_Offset; + Index : Ada.Streams.Stream_Element_Offset; + Max : constant Ada.Streams.Stream_Element_Offset := Item'Last; + + begin + First := Item'First; + Index := First - 1; + while First <= Max loop + Send_Socket (Stream.Socket, Item (First .. Max), Index, null); + + -- Exit when all or zero data sent. Zero means that the socket has + -- been closed by peer. + + exit when Index < First or else Index = Max; + + First := Index + 1; + end loop; + + -- For an empty array, we have First > Max, and hence Index >= Max (no + -- error, the loop above is never executed). After a successful send, + -- Index = Max. The only remaining case, Index < Max, is therefore + -- always an actual send failure. + + if Index < Max then + Raise_Socket_Error (Socket_Errno); + end if; + end Write; + + Sockets_Library_Controller_Object : Sockets_Library_Controller; + pragma Unreferenced (Sockets_Library_Controller_Object); + -- The elaboration and finalization of this object perform the required + -- initialization and cleanup actions for the sockets library. + +end GNAT.Sockets; |