/* OS/2 Rexx or WindowsNT ooRexx whois client */ /* new version 2.1.3: */ /* Finally a manual, see */ /* for the version history. Minor updates still documented here: */ /* 2.1.3: Bug fix, CHCP is NOT the needed Windows ANSI codepage. */ /* For now assume 1252 if running under NT ooREXX. Sorry. */ /* 2.1.2: IETF 72 edition (adding IPv6 support for DNSBL queries) */ /* 2.1.1: disabled whois.nic.ki unknown host (IANA) */ /* 2.1.1: disabled whois.nic.tel unknown host (IANA) */ /* 2.1.1: disabled whois.cctld.uz unknown host (IANA) */ /* 2.1.1: replaced whois.nic.ms wrong host (IANA) */ /* 2.1.1: replaced whois.co.ug found host (IANA) */ /* 2.1.1: replaced whois.nic.pr found host (IANA) */ /* 2.1.1: replaced vunic.vu (omit .vu in queries) */ /* 2.1.1: enabled whois.nic.bi RFC-ignorant (no TPOC) */ /* 2.1.1: enabled whois.registry.gy RFC-ignorant (no TPOC) */ /* 2.1.1: enabled whois.nic.ht no e-mail contact (?) */ /* 2.1.1: enabled whois.nic.mq (omit .mq in queries) */ /* 2.1.1: not enabled: FJ, GG, JE RFC-ignorant, unusable */ /* 2.1.1: not enabled: BL, MF ccTLD not yet assigned */ /* 2.1.1: ignored whois.nic.cm domain grabber */ /* 2.1.1: ignored whois.fm domain grabber */ /* 2.1.1: ignored whois.gd domain grabber */ /* 2.1.1: ignored whois.nic.gd domain grabber */ /* 2.1.1: ignored whois.nic.kn domain grabber */ /* 2.1.1: removed whois.pn domain grabber */ /* 2.1.1: removed whois.nic.pw unknown, was disabled */ /* 2.1.1: added whois.nic.asia found host (IANA) */ /* 2.1.1: added whois.adsib.gob.bo found host (IANA) */ /* 2.1.1: added whois.dj disabled, unclear purpose */ /* 2.1.1: added whois.nic.fk disabled, unclear purpose */ /* 2.1.1: added whois.nic.gh disabled, unclear purpose */ /* 2.1.1: added whois.nic.im no e-mail contact (?) */ /* 2.1.1: added whois.kcce.kp (www.kcce.kp IANA) */ /* 2.1.1: added whois.nic.me disabled, no whois (IANA) */ /* 2.1.1: added whois.umac.mo disabled, unclear purpose */ /* 2.1.1: added whois.sotelma.ml disabled, no whois server */ /* 2.1.1: added whois.sunrise.mp disabled, no whois server */ /* 2.1.1: added whois.nic.org.mt RFC-ignorant (no TPOC) */ /* 2.1.1: added whois.domaine.nc disabled, no whois server */ /* 2.1.1: added whois.nic.sl disabled, unusable answer */ /* 2.1.1: added whois.isoc.sd disabled, no whois server */ /* 2.1.1: added whois.org.sz disabled, no whois server */ /* Warning, the data used to "guess" whois servers for TLDs isn't */ /* up to date. The authoritative source is whois.iana.org, use */ /* `rxwhois TLD` as shorthand for `rxwhois -h whois.iana.org TLD` */ /* Some servers apparently exist, but don't answer whois queries */ /* as required by RfC 1032. These hosts are "disabled" by "???" */ /* at the end of the 2nd column of the whois server list below. */ /* domains | whois server (at port 43) | info >>>>>>>>>>>>>>>>>>>>> .ac | whois.nic.ac | http://www.nic.ac/cgi-bin/whois .ae | whois.nic.ae | .aero | whois.aero | .ag | whois.nic.ag | http://www.nic.ag/ .ai | whois.ai | http://whois.offshore.ai .am | whois.nic.am | https://www.amnic.net/whois/ .as | whois.nic.as | .asia | whois.nic.asia | .at | whois.nic.at | .au | whois.aunic.net | .be | whois.dns.be | .bg | whois.register.bg | .bi | whois.nic.bi | http://www.nic.bi/Nic-search.asp .biz | whois.nic.biz | .bj | www.nic.bj | .bo | whois.adsib.gob.bo | http://www.nic.bo/buscar.php .br | whois.nic.br | .ca | whois.cira.ca | .cat | whois.cat | http://www.domini.cat .cc | whois.nic.cc | .cd | whois.nic.cd | .ch | whois.nic.ch | .ci | whois.nic.ci | http://www.nic.ci .ck | whois.nic.ck | .cl | whois.nic.cl | http://www.nic.cl/cgi-bin/dom-CL?q=nic .cn | whois.cnnic.net.cn | .com | whois.crsnic.net | .coop | whois.nic.coop | .cx | whois.nic.cx | http://www.nic.cx/whois.jsp .cz | whois.nic.cz | .de | whois.denic.de | http://www.denic.de/de/domains/technik/denic_whois-server/ .dk | whois.nic.dk | http://www.dk-hostmaster.dk/dkwhois.php .dm | whois.nic.dm | http://www.nic.dm/whois.jsp .edu | whois.educause.edu | .ee | whois.eenet.ee | http://www.eenet.ee/info/index.html .eu | whois.eu | .fi | whois.ficora.fi | https://domain.ficora.fi/fiDomain/aca.aspx .fo | whois.ripe.net | http://www.nic.fo/custom2/lookup/domain.asp .fr | whois.nic.fr | .gd | whois.adamsnames.com | .gi | whois2.afilias-grs.net | http://whois.gibnet.gi/ .gl | whois.ripe.net | http://search.greennet.gl/cgi-bin/dnscheck/dnscheck.pl .gm | whois.ripe.net | http://www.nic.gm/htmlpages/whois.htm .gp | whois.nic.gp | .gs | whois.nic.gs | http://www.adamsnames.tc/whois/ .gy | whois.registry.gy | http://registry.gy/ .hk | whois.hkdnr.net.hk | http://web.hkdnr.net.hk/hkdnr/index.jsp .hm | whois.registry.hm | http://www.registry.hm/ .hn | whois2.afilias-grs.net | .ht | whois.nic.ht | http://www.nic.ht/info/whois.cfm .hu | whois.nic.hu | .ie | whois.domainregistry.ie | http://213.190.149.196/search/whois.html .il | whois.isoc.org.il | .im | whois.nic.im | http://www.nic.im/exist.html .in | whois.registry.in | http://www.inregistry.in/whois_search/ .info | whois.afilias.info | .int | whois.iana.org | http://whois.iana.org/ .io | whois.nic.io | http://www.io.io/whois.html .ir | whois.nic.ir | http://www.nic.ir/dns.html .is | whois.isnic.is | .it | whois.nic.it | http://www.nic.it/cgi-bin/whois.pl .jobs | jobswhois.verisign-grs.com | http://registrar.verisign-grs.com/whois/whois_jobs.html .jp | whois.nic.ad.jp | .ke | whois.kenic.or.ke | http://www.kenic.or.ke/whois.php .kp | whois.kcce.kp | http://kcce.kp .kr | whois.nic.or.kr | .kz | whois.nic.kz | http://www.nic.kz/cgi-bin/whois .la | whois.nic.la | http://www.nic.la .li | whois.nic.li | .lt | whois.domreg.lt | http://whois.domreg.lt/cgi-bin/whois .lu | whois.dns.lu | .lv | whois.nic.lv | http://www.nic.lv/DNS/list.php .ly | whois.nic.ly | http://www.nic.ly/ .ma | whois.iam.net.ma | .mc | whois.ripe.net | http://www.nic.mc .mobi | whois.dotmobiregistry.net | .mq | whois.nic.mq | http://www.nic.mq .ms | whois.nic.ms | .mt | whois.nic.org.mt | http://www.nic.org.mt/dir/home.html .mu | whois.nic.mu | http://www.nic.mu/whois.jsp .museum | whois.museum | http://whois.museum .mx | whois.nic.mx | .my | whois1.mynic.net.my | http://whois.mynic.net.my .na | whois.na-nic.com.na | http://www.lisse.na/cgi-bin/whois.cgi .name | whois.nic.name | .net | whois.crsnic.net | .nf | whois.nic.cx | http://www.nic.nf/whois.jsp .nl | whois.domain-registry.nl | .no | whois.norid.no | .nu | whois.nic.nu | .nz | whois.srs.net.nz | .org | whois.pir.org | .pl | whois.dns.pl | .pm | whois.nic.pm | http://www.nic.pm/ .pr | whois.nic.pr | http://www.nic.pr/index.asp?f=0 .pro | whois.registrypro.pro | http://www.registrypro.pro .pt | whois.nic.pt | .re | whois.nic.re | .ro | whois.rotld.ro | .ru | whois.ripn.net | .sa | saudinic.net.sa | http://www.saudinic.net.sa/cgi-bin/whois.cgi .sb | whois.nic.net.sb | http://www.sbnic.net.sb/search.htm .sc | whois2.afilias-grs.net | http://www.nic.sc .se | whois.nic-se.se | http://www.nic-se.se .sg | whois.nic.net.sg | .sh | whois.nic.sh | http://www.nic.sh .si | whois.arnes.si | .sk | whois.sk-nic.sk | .sm | whois.ripe.net | .st | whois.nic.st | http://www.nic.st/ .su | whois.ripn.net | .tc | whois.tc | http://www.adamsnames.tc/whois/ .tf | whois.nic.tf | http://www.nic.tf .th | whois.thnic.net | .tk | whois.dot.tk | http://www.nic.tk/vc001200.html .tl | whois.nic.tl | .tm | whois.nic.tm | http://www.nic.tm .to | whois.tonic.to | http://whois.tonic.to/whois.htm .tp | whois.nic.tl | .tr | whois.metu.edu.tr | .travel | whois.nic.travel | http://www.registry.travel .tv | whois.nic.tv | http://www.tv .tw | whois.twnic.net.tw | .ua | whois.net.ua | .ug | whois.co.ug | http://www.registry.co.ug/whois/index.html .us | whois.nic.us | http://www.nic.us/policies/whois.html .uy | nic.uy | .uz | whois.cctld.uz | http://www.reg.uz/whoisr.html .va | whois.ripe.net | .vc | whois2.afilias-grs.net | .ve | whois.nic.ve | http://www.nic.ve/nicwho01.html .vg | whois.vg | http://www.adamsnames.tc/whois/ .vu | vunic.vu | http://www.vunic.vu/whois.htm .wf | whois.nic.wf | http://www.nic.wf/ .ws | whois.website.ws | http://worldsite.ws/utilities/lookup.dhtml .yt | whois.nic.yt | http://www.nic.yt/ .bz | whois.belizenic.bz ??? | http://www.belizenic.bz .dj | whois.dj ??? | http://www.nic.dj .do | whois.nic.do ??? | http://www.nic.do/whois-hin.php3 .ec | whois.nic.ec ??? | http://www.nic.ec/eng/registro/paso1.asp .fj | whois.fj ??? | http://whois.fj/public/whois.php .fk | whois.nic.fk ??? | http://www.fidc.co.fk/ .gf | whois.nplus.gf ??? | .gg | whois.channelisles.net ??? | http://www.channelisles.net/whois/whoisinfo.shtml .gh | whois.nic.gh ??? | http://www.ghana.com.gh .gov | whois.dotgov.gov ??? | http://www.nic.gov .gr | whois.grnet.gr ??? | .gw | whois.nic.gw ??? | .je | whois.channelisles.net ??? | http://www.channelisles.net/whois/whoisinfo.shtml .kg | whois.domain.kg ??? | http://whois.domain.kg/whois.html .ki | whois.nic.ki ??? | http://www.ki/dns/whois.html .ky | whois.nic.ky ??? | http://kynseweb.messagesecure.com/whoisfrontend.asp .lk | whois.nic.lk ??? | http://www.nic.lk/cgi-bin/search.cgi .md | whois.nic.md ??? | http://www.nic.md/whois.php .me | whois.nic.me ??? | http://www.nic.me .mg | whois.nic.mg ??? | http://whois.nic.mg/ .ml | whois.sotelma.ml ??? | http://www.sotelmal.ml .mn | whois.nic.mn ??? | http://www.nic.mn .mo | whois.umac.mo ??? | http://www.monic.net.mo/ .mp | whois.sunrise.mp ??? | http://get.mp .nc | whois.domaine.nc ??? | http://www.domaine.nc/en/whois.html .pa | whois.nic.pa ??? | http://www.nic.pa/ .pe | whois.nic.pe ??? | http://www.nic.pe/data-reg-busq.htm .ph | whois.nic.ph ??? | http://www.domains.ph/DomainSearch.asp .pk | whois.net.pk ??? | http://pknic.net.pk .sd | whois.isoc.sd ??? | http://www.isoc.sd .sl | whois.nic.sl ??? | http://sierratel.sl/domain/ .sz | whois.org.sz ??? | http://www.sispa.org.sz .tel | whois.nic.tel ??? | http://www.nic.tel .tn | whois.ati.tn ??? | http://whois.ati.tn .ad | | http://www.nic.ad/ .af | | http://www.nic.af/whois.jsp .an | | http://www.una.an/AN_DOMReg/ .ao | | http://www.dns.ao .ar | | http://www.nic.ar/consultas/consdom.html .az | | http://www.whois.az .ba | | http://www.nic.ba/stream/whois/ .bb | | http://domains.org.bb .bm | | http://www.bermudanic.bm/cgi-bin/BermudaNIC/rwhois_query.pl .bn | | http://www.brunet.bn .bs | | http://dns.nic.bs/cgi-bin/search.pl .bt | | http://www.nic.bt/ .bv | | http://www.norid.no/bv-sj.html .by | | http://www.tld.by/indexeng.html .cg | | http://www.nic.cg/cgi-bin/whoiscg.pl .cm | | http://www.info.camnet.cm .co | | https://www.nic.co/ .cr | | http://www.nic.cr/consulta-dns.html .cu | | http://www.nic.cu/consult.html .dz | | http://www.nic.dz/anglais/pdom-att-eng.htm .es | | https://www.nic.es/esnic/jsp/whois_ctos.jsp .fm | | http://www.dot.fm/whois.html .ge | | http://www.nic.net.ge/index_en.html .gt | | http://www.gt/whois.htm .hr | | http://www.dns.hr/pretrazivanje.html .jo | | http://www.nis.jo/dns/ .kw | | http://www.kw .lb | | http://www.aub.edu.lb/lbdr/search.html .mil | | http://www.nic.mil/dodnic/ .mr | | http://www.univ-nkc.mr/nic_mr.html .mw | | http://www.registrar.mw .ni | | http://www.nic.ni/whois.htm .np | | http://www.mos.com.np/domsearch.html .nr | | http://www.cenpac.net.nr/dns/whois.html .om | | http://www.omnic.om/onlineUser/WHOISLookup.jsp .pn | | http://www.government.pn/PnRegistry/whois.html .ps | | http://www.nic.ps/whois/domain_whois.php?dname= .pw | | http://www.pwregistry.pw/ .py | | http://www.nic.py/consultas/ .rw | | http://www.nic.rw/cgi-bin/whoisrw.pl .rs | | http://www.nic.rs .sj | | http://www.norid.no/bv-sj.html .sn | | http://www.nic.sn .sv | | http://www.uca.edu.sv/dns/indicei.html .tg | | http://www.nic.tg .tt | | http://www.nic.tt/cgi-bin/search.pl .vi | | http://www.nic.vi/whoisform.htm .vn | | http://www.vnnic.net.vn/english/reg_domain/index.html .yu | | http://www.nic.yu/index-e.html .al | | ? .aq | | ? .aw | | ? .ax | | ? .bd | | ? .bf | | ? .bh | | ? .bl | whois.nic.bl ??? | expected: http://www.nic.bl .bw | | ? .cf | | ? .cv | | ? .cy | | ? .eg | | ? .eh | | ? .er | | ? .et | | ? .ga | | ? .gb | | ? .gn | | ? .gq | | ? .gu | | ? .id | | ? .iq | | ? .jm | | ? .kh | | ? .km | | ? .kn | | ? .lc | | ? .lr | | ? .ls | | ? .mf | whois.nic.mf ??? | expected: http://www.nic.mf .mh | | ? .mk | | ? .mm | | ? .mv | | ? .mz | | ? .ne | | ? .ng | | ? .pf | | ? .pg | | ? .qa | | ? .so | | ? .sr | | ? .sy | | ? .td | | ? .tj | | ? .tz | | ? .um | | ? .ye | | ? .zm | | ? .zw | | ? .ac.uk | whois.ja.net | .gov.uk | whois.ja.net | .uk | whois.nic.uk | .ac.za | whois.ac.za | http://www.tenet.ac.za/cgi/cgi_domainquery.exe .co.za | whois.co.za ??? | http://co.za/cgi-bin/whois.sh .org.za | rwhois.org.za:4321 | http://www.org.za/cgi-bin/rwhois .za | | http://www2.frd.ac.za/uninet/zadomains.html .e164.arpa | whois.ripe.net | http://purl.net/net/rfc/2916 .arpa | whois.iana.org | http://purl.net/net/rfc/3712 .bu | | ISO 3166-1 Burma (now .mm) .cp | | ISO 3166-1 Clipperton Is. (now .pf) .cs | | ISO 3166-1 (see .me .rs .yu, .cz .sk) .dg | | ISO 3166-1 Diego Garcia (now .io) .dy | | ISO 3166-1 Benin (now .bj) .ea | | ISO 3166-1 Ceuta, Melilla (now .es) .ew | | ISO 3166-1 Estonia (now .ee) .fl | | ISO 3166-1 Liechtenstein (now .li) .fx | | ISO 3166-1 France Metropol. (now .fr) .ic | | ISO 3166-1 Canary Islands (now .es) .ja | | ISO 3166-1 Jamaica (now .jm) .lf | | ISO 3166-1 Libya Fezzan (now .ly) .nt | | ISO 3166-1 Neutral Territory .pi | | ISO 3166-1 Philippines (now .ph) .ra | | ISO 3166-1 R of Argentina (now .ar) .rb | | ISO 3166-1 R of B (.bo + .bw) .rc | | ISO 3166-1 R of China (= cn hk mo tw) .rh | | ISO 3166-1 R of Haiti (now .ht) .ri | | ISO 3166-1 R of Indonesia (now .id) .rl | | ISO 3166-1 R of Lebanon (now .lb) .rm | | ISO 3166-1 R of Madagascar (now .mg) .rn | | ISO 3166-1 R of Niger (now .ne) .rp | | ISO 3166-1 R of Philippines (now .ph) .sf | | ISO 3166-1 Suomi Finland (now .fi) .ta | | ISO 3166-1 Tristan da Cunha (now .sh) .wg | | ISO 3166-1 Grenada (now .gd) .wl | | ISO 3166-1 Saint Lucia (now .lc) .wv | | ISO 3166-1 Saint Vincent (now .vc) .yv | | ISO 3166-1 Venezuela (now .ve) .zr | | ISO 3166-1 Zaire (now .cd) .arts | | http://www.gtld-mou.org/docs/faq.html#2.1 .firm | | http://www.gtld-mou.org/docs/faq.html#2.1 .nom | | http://www.gtld-mou.org/docs/faq.html#2.1 .rec | | http://www.gtld-mou.org/docs/faq.html#2.1 .shop | | http://www.gtld-mou.org/docs/faq.html#2.1 .web | | http://www.gtld-mou.org/docs/faq.html#2.1 .local | | ? .nato | | ? .example | | http://purl.net/net/rfc/2606 .invalid | | http://purl.net/net/rfc/2606 .localhost | | http://purl.net/net/rfc/2606 .test | | http://purl.net/net/rfc/2606 .test | whois.abuse.net | test entry for option -a .test | whois.cyberabuse.org | test entry for option -c .test | whois.networksolutions.com | test entry for option -n .test | whois.thur.de | test entry for option -t .test | whois.cymru.com | test entry for IPs .test | whois.afrinic.net | test entry for *-afrinic .test | whois.apnic.net | test entry for *-ap .test | whois.arin.net | test entry for *-arin .test | whois.lacnic.net | test entry for *-lacnic .xn--kgbechtv | whois.iana.org | IDN test 2007 Arabic .xn--hgbk6aj7f53bba | whois.iana.org | IDN test 2007 Persian .xn--0zwm56d | whois.iana.org | IDN test 2007 Chinese (s) .xn--g6w251d | whois.iana.org | IDN test 2007 Chinese (t) .xn--80akhbyknj4f | whois.iana.org | IDN test 2007 Russian .xn--11b5bs3a9aj6g | whois.iana.org | IDN test 2007 Hindi .xn--jxalpdlp | whois.iana.org | IDN test 2007 Greek .xn--9t4b11yi5a | whois.iana.org | IDN test 2007 Korean .xn--deba0ad | whois.iana.org | IDN test 2007 Yiddish .xn--zckzah | whois.iana.org | IDN test 2007 Japanese .xn--hlcj6aya9esc7a | whois.iana.org | IDN test 2007 Tamil TLDomain | whois server (at port 43) | info <<<<<<<<<<<<<<<<< **/ signal on novalue name TRAP ; signal on syntax name TRAP signal on failure name TRAP ; signal on halt name TRAP if RxFuncQuery( 'SockLoadFuncs' ) then do call RxFuncAdd 'SockLoadFuncs', 'RXSOCK', 'SockLoadFuncs' call SockLoadFuncs 'N' /* TRAP if RXSOCK.DLL not found */ end parse arg OPT WHO DOM ; DOM = strip( DOM ) RFCI = '.rfc-ignorant.org' ; CP = CHCP() CRLF = x2c( 0D0A ) ; EXPO = 'TSOCK CRLF RFCI CP' select when arg( 1 ) = '' then exit USAGE( ) when arg( 1 ) = '*' then exit CHECK( ) when OPT = '-h' | OPT = '-H' then exit QUERY( WHO, DOM ) when OPT = '-a' | OPT = '-A' then exit ABUSE( WHO DOM ) when OPT = '-c' | OPT = '-C' then exit CYBER( WHO DOM ) when OPT = '-r' | OPT = '-R' then exit RIPED( WHO DOM ) when OPT = '-d' | OPT = '-D' then exit DENIC( WHO DOM ) when OPT = '-j' | OPT = '-J' then exit JPNIC( WHO DOM ) when OPT = '-n' | OPT = '-N' then exit NETWO( WHO DOM ) when OPT = '-t' | OPT = '-T' then exit HACKE( WHO DOM ) when OPT = '-i' | OPT = '-I' then do OPT = DOM ; DOM = IHOST( WHO ) if DOM = '' then exit USAGE( 'unknown host' WHO ) say 'rxwhois' space( DOM OPT ) end /* IPv4 -> host, or host -> IPv4 */ when OPT = '-k' | OPT = '-K' then do CP = 878 /* hard wired KOI8-R IDN test: */ OPT = x2c( 'C9 D3 D0 D9 D4 C1 CE C9 C5' ) exit QUERY( 'whois.iana.org', OPT ) end when abbrev( OPT, '-' ) then exit USAGE( arg( 1 )) when sign( pos( ':', OPT )) then select when WHO <> '' then exit USAGE( WHO DOM ) when ISIP6( OPT ) then exit 0 otherwise exit USAGE( 'bad IP' OPT ) end when sign( pos( '.', OPT )) then parse arg DOM OPT when WHO <> '' then exit USAGE( WHO DOM ) otherwise /* IANA knows most existing TLDs */ DOM = translate( OPT ) /* RFCI knows many ignorant TLDs */ if abbrev( DOM, 'XN--' ) < sign( pos( '-', OPT )) then exit ALIAS( OPT ) call GHOST OPT, '.whois' || RFCI, OPT exit QUERY( 'whois.iana.org', OPT ) end /* ALIAS() hack for NIC handles */ parse value reverse( DOM ) with T.1 '.' T.2 '.' T.3 '.' TIP if verify( T.1 || T.2 || T.3 || TIP, '0123456789' ) = 0 then do if TIP = '' then exit USAGE( 'invalid IP' DOM ) WHO = space( reverse( TIP T.3 T.2 T.1 )) TIP = DNSBL( translate( WHO, '.', ' ' ), DOM ) if TIP <> 0 then say DOM 'not found on' TIP 'DNSBLs' say exit QUERY( 'whois.cymru.com', DOM ) end WHO = translate( DOM ) ; T.2 = lastpos( '.', DOM ) if T.2 = 0 then exit USAGE( 'host' DOM 'not allowed here :-)' ) T.1 = substr( WHO, T.2 ) ; T.2 = left( WHO, T.2 - 1 ) T.3 = lastpos( '.', T.2 ) /* handle some special SLDs like */ if T.3 = 0 then T.2 = T.1 /* .e164.arpa (T.1 TLD, T.2 SLD) */ else T.2 = substr( T.2, T.3 ) || T.1 if T.1 <> '' then do LINE = 1 to sourceline() parse upper value sourceline( LINE ) with TLD '|' HOST '|' TIP if TLD <> T.1 & TLD <> T.2 then iterate LINE if words( HOST ) = 1 then exit QUERY( HOST, space( DOM OPT )) if length( TIP ) > 1 then exit USAGE( 'see' TIP 'for' TLD ) exit USAGE( 'unknown whois server for domain' TLD HOST ) end LINE exit USAGE( 'unknown top level domain' T.1 ) HACKE: return QUERY( 'whois.thur.de' , arg( 1 )) NETWO: return QUERY( 'whois.networksolutions.com' , arg( 1 )) DENIC: return QUERY( 'whois.denic.de', '-Tdn,ace' arg( 1 )) RIPED: return QUERY( 'whois.ripe.net', '-B' arg( 1 )) CYBER: return QUERY( 'whois.cyberabuse.org' , arg( 1 )) JPNIC: return QUERY( 'whois.nic.ad.jp', arg( 1 ) '/e' ) ISIP6: procedure expose (EXPO) /* 0: no IPv6, 1: processed IPv6 */ arg IP6 ; RIP = '' HEX = XIPV6( IP6 ) ; if HEX = '' then return 0 do N = 1 to 32 /* RIP = reverse ip6.arpa format */ RIP = RIP || '.' || substr( HEX, N, 1 ) end N N = DNSBL( substr( RIP, 2 ), IP6 ) if N <> 0 then say IP6 'not found on' N 'DNSBLs' call QUERY 'whois.cymru.com', IP6 return 1 DNSBL: procedure expose (EXPO) /* for 127.0.0.2 expect result 0 */ arg RIP, IP ; BAD = 9 BAD = BAD - GHOST( RIP, '.virbl.dnsbl.bit.nl', IP ) /* 9 */ BAD = BAD - GHOST( RIP, '.ix.dnsbl.manitu.net', IP ) /* 8 */ BAD = BAD - GHOST( RIP, '.bl.spamcop.net', IP ) /* 7 */ BAD = BAD - GHOST( RIP, '.multi.surbl.org', IP ) /* 6 */ BAD = BAD - GHOST( RIP, '.psbl.surriel.com', IP ) /* 5 */ BAD = BAD - GHOST( RIP, '.combined.njabl.org', IP ) /* 4 */ BAD = BAD - GHOST( RIP, '.list.dsbl.org', IP ) /* 3 */ BAD = BAD - GHOST( RIP, '.zen.spamhaus.org', IP ) /* 2 */ return BAD - GHOST( RIP, '.cbl.abuseat.org', IP ) /* 1 */ ABUSE: procedure expose (EXPO) /* SURBL, RFCI, whois.abuse.net: */ parse arg DOM BAD ; SURBL = '.multi.surbl.org' RIP.1 = '.postmaster' ; RIP.2 = '.abuse' RIP.3 = '.whois' ; RIP.4 = '.dsn' RIP.5 = '.bogusmx' ; RIP.0 = 5 if DOM <> '' then do /* if argument: whois.abuse.net */ BAD = GHOST( DOM, SURBL, DOM ) do N = 1 to RIP.0 BAD = BAD + GHOST( DOM, RIP.N || RFCI, DOM ) end N if BAD = 0 then say DOM 'not found at' RFCI 'or' SURBL if sign( pos( '.', DOM )) = 0 then do DOM = DOM || '.whois-servers.net' BAD = IHOST( DOM ) if BAD <> '' then do say DOM '= [' || BAD || ']' IHOST( BAD ) end end return QUERY( 'whois.abuse.net', arg( 1 )) end DOM = 'example.tld' ; BAD = RIP.0 do N = 1 to RIP.0 /* use example.tld for RFCI test */ BAD = BAD - GHOST( DOM, RIP.N || RFCI, DOM ) end N if BAD <> 0 then say BAD 'RHSBLs did not work as expected' BAD = DNSBL( '2.0.0.127', '127.0.0.2' ) if BAD <> 0 then say BAD 'DNSBLs did not work as expected' return 0 ALIAS: procedure expose (EXPO) /* check well-known NIC handles: */ arg A /* match uppercase right / left */ HND.1 = '-AFRINIC' ; WHO.1 = 'whois.afrinic.net' HND.2 = '-ARIN' ; WHO.2 = 'whois.arin.net' HND.3 = '-AP' ; WHO.3 = 'whois.apnic.net' HND.4 = '-AU' ; WHO.4 = 'whois.aunic.net' HND.5 = '-CKNIC' ; WHO.5 = 'whois.nic.ck' HND.6 = '-CZ' ; WHO.6 = 'whois.nic.cz' HND.7 = '-DK' ; WHO.7 = 'whois.nic.dk' HND.8 = '-FRNIC' ; WHO.8 = 'whois.nic.fr' HND.9 = '-HST' ; WHO.9 = 'whois.networksolutions.com' HND.10 = '-ITNIC' ; WHO.10 = 'whois.nic.it' HND.11 = '-LACNIC' ; WHO.11 = 'whois.lacnic.net' HND.12 = '-NICAT' ; WHO.12 = 'whois.nic.at' HND.13 = '-NICIR' ; WHO.13 = 'whois.nic.ir' HND.14 = '-NORID' ; WHO.14 = 'whois.norid.no' HND.15 = '-RIPE' ; WHO.15 = 'whois.ripe.net' HND.16 = '-RIPN' ; WHO.16 = 'whois.ripn.net' do N = 1 to 16 L = length( HND.N ) if abbrev( HND.N, '-' ) /* matched right / left end: nop */ then if right( A, L ) <> HND.N then iterate N ; else nop else if left( A, L ) <> HND.N then iterate N ; else nop exit QUERY( WHO.N, arg( 1 )) end N exit USAGE( 'unknown NIC handle' arg( 1 )) USAGE: procedure expose (EXPO) /* show usage or error message */ parse source . . THIS TEXT = 'or :' THIS 'IP # DNSBLs' TEXT = 'or :' THIS '* # test all' || CRLF || TEXT TEXT = 'or :' THIS 'NIC-handle # guess -h' || CRLF || TEXT TEXT = 'or :' THIS 'domain.TLD # guess -h' || CRLF || TEXT TEXT = 'or :' THIS '-i IP # name(IP)' || CRLF || TEXT TEXT = 'or :' THIS '-i NN # addr(NN)' || CRLF || TEXT TEXT = 'or :' THIS '-j query # JPNIC /e' || CRLF || TEXT TEXT = 'or :' THIS '-d domain # DENIC -Tdn' || CRLF || TEXT TEXT = 'or :' THIS '-r domain # ripe.net' || CRLF || TEXT TEXT = 'or :' THIS '-a domain # abuse.net' || CRLF || TEXT TEXT = 'usage:' THIS '-h server query' || CRLF || TEXT if arg( 1, 'e' ) then TEXT = 'error:' arg( 1 ) || CRLF || TEXT say TEXT ; return 1 IHOST: procedure expose (EXPO) /* IPv4 -> host, or host -> IPv4 */ if verify( arg( 1 ), '0123456789.' ) = 0 then if SockGetHostByAddr( arg( 1 ), 'P.' ) then return P.NAME ; else return '' else if SockGetHostByName( arg( 1 ), 'P.' ) then return P.ADDR ; else return '' GHOST: procedure expose (EXPO) /* (ab)use DNS GetHostByName */ NAME = arg( 1 ) || arg( 2 ) if SockGetHostByName( NAME, 'P.' ) = 0 then return 0 parse var P.ADDR A '.' B '.' C '.' D if A <> 127 | B > 1 | ( B = 0 & C = 0 & D <= 1 ) then do say 'unexpected result' P.ADDR 'for' NAME ; return 1 end /* 127.0.0.0/31 is utter dubious */ A = 256 * C + D ; B = '' ; C = '0123456789ABCDEF' do D = 1 to 16 until A = 0 & 8 <= D if A // 2 then B = substr( C, D, 1 ) || B else B = '-' || B A = A % 2 /* 127.0.c.d => bits 256 * c + d */ end D /* 127.1.c.d for opm.blitzed.org */ say arg( 3 ) '(' || B || '):' arg( 2 ) ; return 1 QUERY: procedure expose (EXPO) /* send any TEXT to THIS port 43 */ signal on novalue name TFAIL ; signal on syntax name TFAIL signal on failure name TFAIL ; signal on halt name TFAIL parse arg THIS ':' PORT , TEXT PORT = strip( PORT ) ; if PORT = '' then PORT = 43 THIS = strip( THIS ) ; TEXT = UTF.O( strip( TEXT ) || CRLF, CP ) select when TOPEN( THIS, PORT ) then return 1 when TSEND( TEXT ) <> 0 then return TFAIL() otherwise if PORT <> 43 & PORT <> 4321 then call TSEND if PORT <> 43 then THIS = THIS || ':' || PORT EOL = x2c( 0A ) ; TEXT = 'whois -h' THIS TEXT do LINE = 0 until TEXT = '' THIS = '' do while sign( pos( EOL, TEXT )) parse var TEXT HEAD (EOL) TEXT if abbrev( CRLF, right( HEAD, 1 )) then THIS = THIS || HEAD || EOL else THIS = THIS || HEAD || CRLF end call charout /**/, UTF.I( THIS || TEXT, CP ) TEXT = TREAD() end LINE if LINE = 0 then return TFAIL() call SockClose TSOCK ; return 0 end CHECK: procedure expose (EXPO) /* check default WHOIS servers */ SKIP = '' ; INFO = '' ; DISS = '' do LINE = 1 to sourceline() parse value sourceline( LINE ) with TLD '|' HOST '|' TIP select when left( TLD, 1 ) <> '.' then iterate LINE when HOST = '' & TIP = '' then iterate LINE when HOST = '' & TIP = '?' then SKIP = SKIP TLD when HOST = '' then INFO = INFO TLD otherwise call charout /**/, '*' || left( TLD, 10 ) call charout /**/, left( strip( HOST ), 27 ) TEXT = strip( TLD ) || CRLF parse value word( HOST, 1 ) with TIP ':' PORT if PORT = '' then PORT = 43 select /* incl. disabled HOST (2 words) */ when TOPEN( TIP, PORT ) then nop when TSEND( TEXT ) then call TFAIL when TREAD() = '' then call TFAIL when words( HOST ) > 1 then do call SockClose TSOCK ; DISS = DISS TLD say 'maybe' /* if intentionally (?) disabled */ end otherwise /* if no reply then sock error 0 */ TEXT = left( CRLF, 1 ) ; call SockClose TSOCK call charout /**/, TEXT || left( '', 39 ) || TEXT end /* if any reply overwrite line */ end end LINE say CTLDS( 'not supported:', INFO ) say CTLDS( 'unknown whois:', SKIP ) say CTLDS( 'disabled host:', DISS ) return 0 CTLDS: procedure expose (EXPO) /* wrap long CHECK() TLD lists */ parse arg TEXT, TLDS do while TLDS <> '' parse var TLDS '.' NEXT TLDS if length( TEXT NEXT ) < 80 then TEXT = TEXT NEXT ; else do say TEXT ; TEXT = '' NEXT end end return TEXT /* -------------------------------------------------------------- */ /* Convert STD 66 to 32 hex. digits (empty = error) */ XIPV6: procedure expose (EXPO) /* IPv6 to hex. or empty (error) */ arg IP6 RHS ; N = lastpos( ':', IP6 ) if ( N = 0 ) | ( RHS <> '' ) then return '' RHS = substr( IP6, N + 1 ) /* right hand side after all ':' */ if sign( pos( '.', RHS )) then do if sign( verify( RHS, '0.123456789' )) then return '' IP6 = left( IP6, N ) /* convert trailing IPv4 to hex. */ do N = 0 while RHS <> '' parse var RHS LHS '.' RHS if ( LHS = '' ) | ( N = 4 ) then return '' if 255 < LHS then return '' IP6 = IP6 || d2x( LHS, 2 ) if N = 1 then IP6 = IP6 || ':' end N end parse var IP6 LHS '::' RHS ; IP6 = '' if sign( pos( '::', RHS )) then return '' if abbrev( RHS, ':' ) then return '' do while LHS <> '' parse var LHS TOP ':' LHS if datatype( TOP, 'X' ) = 0 then return '' TOP = strip( TOP, 'L', 0 ) if length( TOP ) > 4 then return '' IP6 = IP6 || right( TOP, 4, 0 ) end do while RHS <> '' parse var RHS TOP ':' RHS if datatype( TOP, 'X' ) = 0 then return '' TOP = strip( TOP, 'L', 0 ) if length( TOP ) > 4 then return '' LHS = LHS || right( TOP, 4, 0 ) end TOP = pos( '::', arg( 1 )) ; RHS = LHS N = length( IP6 ) ; LHS = IP6 if ( 32 = N ) & ( TOP = 0 ) then return IP6 N = length( RHS ) + N if ( 28 < N ) | ( TOP = 0 ) then return '' do until N = 32 LHS = LHS || 0000 ; N = N + 4 end return LHS || RHS /* '::' must be one or more 0000 */ /* -------------------------------------------------------------- */ /* Emulate SysQueryProcessCodePage() for ooRexx under Windows NT: */ CHCP: procedure /* determine OS/2 or NT codepage */ parse source X . if X = 'OS/2' then do /* use SysQueryProcessCodePage() */ Q = 'SysQueryProcessCodePage' if RxFuncQuery( Q ) then if RxFuncAdd( Q, 'RexxUtil', Q ) then exit TRAP( "can't add RexxUtil" Q ) return SysQueryProcessCodePage() end return 1252 /* unclear how to get NT ANSI CP */ /* -------------------------------------------------------------- */ /* 0.8, (c) F.Ellermann */ UTF.I: procedure expose UTF. /* UTF-8 to local charset */ parse arg SRC ; DST = '' ; UTF.8 = UTF.8( arg( 2 )) do while SRC <> '' POS = verify( SRC, UTF.8 ) -1 ; if POS < 0 then leave DST = DST || left( SRC, POS ) ; SRC = substr( SRC, POS + 1 ) POS = verify( x2b( c2x( left( SRC, 1 ))), 1 ) -1 if POS > 1 & POS < 7 then do /* C0..FD introduce 2-6 bytes */ TOP = left( SRC, POS ) ; SRC = substr( SRC, POS + 1 ) DST = DST || UTF.TOP /* surrogates implicitly bad, */ end /* C0..C1 are implicitly bad, */ else do /* 80..BF and FE..FF illegal: */ DST = DST || UTF.? ; SRC = substr( SRC, 2 ) end /* show error character UTF.? */ end return DST || SRC UTF.O: procedure expose UTF. /* local charset to UTF-8 */ parse arg SRC ; DST = '' ; UTF.8 = UTF.8( arg( 2 )) do while SRC <> '' POS = verify( SRC, UTF.8 ) -1 ; if POS < 0 then leave DST = DST || left( SRC, POS ) ; SRC = substr( SRC, POS + 1 ) parse var SRC TOP 2 SRC ; DST = DST || UTF.TOP end return DST || SRC UTF.8: procedure expose UTF. /* initialize Unicode table */ arg PAGE select when PAGE = value( 'UTF..' ) then nop when PAGE = '' & symbol( 'UTF..' ) = 'VAR' then nop otherwise if symbol( 'UTF.?' ) = 'VAR' then T = UTF.? else T = x2c( 1A ) drop UTF. ; UTF. = T /* SUB unknown char.s by 0x1A */ UTF.. = PAGE ; T = '' /* note actual codepage UTF.. */ select /* -------------------------- */ when PAGE = 437 then do /* codepage 437 */ T = T ' C7 FC E9 E2 E4 E0 E5 E7' /* 80 */ T = T ' EA EB E8 EF EE EC C4 C5' /* 88 */ T = T ' C9 E6 C6 F4 F6 F2 FB F9' /* 90 */ T = T ' FF D6 DC A2 A3 A5 20A7 192' /* 98 */ T = T ' E1 ED F3 FA F1 D1 AA BA' /* A0 */ T = T ' BF 2310 AC BD BC A1 AB BB' /* A8 */ T = T '2591 2592 2593 2502 2524 2561 2562 2556' /* B0 */ T = T '2555 2563 2551 2557 255D 255C 255B 2510' /* B8 */ T = T '2514 2534 252C 251C 2500 253C 255E 255F' /* C0 */ T = T '255A 2554 2569 2566 2560 2550 256C 2567' /* C8 */ T = T '2568 2564 2565 2559 2558 2552 2553 256B' /* D0 */ T = T '256A 2518 250C 2588 2584 258C 2590 2580' /* D8 */ T = T ' 3B1 DF 393 3C0 3A3 3C3 B5 3C4' /* E0 */ T = T ' 3A6 398 3A9 3B4 221E 3C6 3B5 2229' /* E8 */ T = T '2261 B1 2265 2264 2320 2321 F7 2248' /* F0 */ T = T ' B0 2219 B7 221A 207F B2 25A0 A0' /* F8 */ end /* -------------------------- */ when PAGE = 819 then do /* ISO 8859-1 (Latin-1) */ do N = 128 to 255 ; T = T d2x( N ) ; end N /* 80-FF */ end /* -------------------------- */ when PAGE = 858 | PAGE = 850 then do T = T ' C7 FC E9 E2 E4 E0 E5 E7' /* 80 */ T = T ' EA EB E8 EF EE EC C4 C5' /* 88 */ T = T ' C9 E6 C6 F4 F6 F2 FB F9' /* 90 */ T = T ' FF D6 DC F8 A3 D8 D7 192' /* 98 */ T = T ' E1 ED F3 FA F1 D1 AA BA' /* A0 */ T = T ' BF AE AC BD BC A1 AB BB' /* A8 */ T = T '2591 2592 2593 2502 2524 C1 C2 C0' /* B0 */ T = T ' A9 2563 2551 2557 255D A2 A5 2510' /* B8 */ T = T '2514 2534 252C 251C 2500 253C E3 C3' /* C0 */ T = T '255A 2554 2569 2566 2560 2550 256C A4' /* C8 */ T = T ' F0 D0 CA CB C8 20AC CD CE' /* D0 */ T = T ' CF 2518 250C 2588 2584 A6 CC 2580' /* D8 */ T = T ' D3 DF D4 D2 F5 D5 B5 FE' /* E0 */ T = T ' DE DA DB D9 FD DD AF B4' /* E8 */ T = T ' AD B1 2017 BE B6 A7 F7 B8' /* F0 */ T = T ' B0 A8 B7 B9 B3 B2 25A0 A0' /* F8 */ /* 0xD5 850: u+0131 small dotless i, 858: u+20AC Euro */ end /* -------------------------- */ when PAGE = 878 then do /* KOI8-R (ibm-878) */ T = T '2500 2502 250C 2510 2514 2518 251C 2524' /* 80 */ T = T '252C 2534 253C 2580 2584 2588 258C 2590' /* 88 */ T = T '2591 2592 2593 2320 25A0 2219 221A 2248' /* 90 */ T = T '2264 2265 A0 2321 B0 B2 B7 F7' /* 98 */ T = T '2550 2551 2552 451 2553 2554 2555 2556' /* A0 */ T = T '2557 2558 2559 255A 255B 255C 255D 255E' /* A8 */ T = T '255F 2560 2561 401 2562 2563 2564 2565' /* B0 */ T = T '2566 2567 2568 2569 256A 256B 256C A9' /* B8 */ T = T ' 44E 430 431 446 434 435 444 433' /* C0 */ T = T ' 445 438 439 43A 43B 43C 43D 43E' /* C8 */ T = T ' 43F 44F 440 441 442 443 436 432' /* D0 */ T = T ' 44C 44B 437 448 44D 449 447 44A' /* D8 */ T = T ' 42E 410 411 426 414 415 424 413' /* E0 */ T = T ' 425 418 419 41A 41B 41C 41D 41E' /* E8 */ T = T ' 41F 42F 420 421 422 423 416 412' /* F0 */ T = T ' 42C 42B 417 428 42D 429 427 42A' /* F8 */ end /* -------------------------- */ when PAGE = 923 then do /* ISO 8859-15 (Latin-9) */ do N = 128 to 159 ; T = T d2x( N ) ; end N /* 80-9F */ T = T ' A0 A1 A2 A3 20AC A5 160 A7' /* A0 */ T = T ' 161 A9 AA AB AC AD AE AF' /* A8 */ T = T ' B0 B1 B2 B3 17D B5 B6 B7' /* B0 */ T = T ' 17E B9 BA BB 152 153 178 BF' /* B8 */ do N = 192 to 255 ; T = T d2x( N ) ; end N /* C0-FF */ end /* -------------------------- */ when PAGE = 1252 | PAGE = 1004 then do T = T '20AC 81 201A 192 201E 2026 2020 2021' /* 80 */ T = T ' 2C6 2030 160 2039 152 8D 17D 8F' /* 88 */ T = T ' 90 2018 2019 201C 201D 2022 2013 2014' /* 90 */ T = T ' 2DC 2122 161 203A 153 9D 17E 17F' /* 98 */ do N = 160 to 255 ; T = T d2x( N ) ; end N /* A0-FF */ end /* -------------------------- */ when PAGE = 'MAC' then do /* Macintosh */ T = T ' C4 C5 C7 C9 D1 D6 DC E1' /* 80 */ T = T ' E0 E2 E4 E3 E5 E7 E9 E8' /* 88 */ T = T ' EA EB ED EC EE EF F1 F3' /* 90 */ T = T ' F2 F4 F6 F5 FA F9 FB FC' /* 98 */ T = T '2020 B0 A2 A3 A7 2022 B6 DF' /* A0 */ T = T ' AE A9 2122 B4 A8 2260 C6 D8' /* A8 */ T = T '221E B1 2264 2265 A5 B5 2202 2211' /* B0 */ T = T '220F 3C0 222B AA BA 3A9 E6 F8' /* B8 */ T = T ' BF A1 AC 221A 192 2248 2206 AB' /* C0 */ T = T ' BB 2026 A0 C0 C3 D5 152 153' /* C8 */ T = T '2013 2014 201C 201D 2018 2019 F7 25CA' /* D0 */ T = T ' FF 178 2044 20AC 2039 203A FB01 FB02' /* D8 */ T = T '2021 B7 201A 201E 2030 C2 CA C1' /* E0 */ T = T ' CB C8 CD CE CF CC D3 D4' /* E8 */ T = T 'F8FF D2 DA DB D9 131 2C6 2DC' /* F0 */ T = T ' AF 2D8 2D9 2DA B8 2DD 2DB 2C7' /* F8 */ /* 0xBD old u+2126 Ohm : new u+03A9 Omega */ /* 0xDB old u+00A4 currency symbol : new u+20AC Euro */ /* 0xF0 old u+2665 black heart suit: new u+F8FF priv. */ end /* -------------------------- */ end /* otherwise force REXX error */ do N = 128 to 255 /* table of UTF-8 characters: */ parse var T SRC T ; DST = '' SRC = reverse( x2b( SRC )) /* scalar bits right to left */ do LEN = 2 until verify( substr( SRC, 8 - LEN ), 0 ) = 0 DST = DST || left( SRC, 6, 0 ) || '01' SRC = substr( SRC, 7 ) /* encoded 6 bits of scalar */ end LEN /* remaining bits of scalar: */ DST = DST || left( SRC, 7 - LEN, 0 ) || 0 DST = x2c( b2x( reverse( DST || copies( 1, LEN )))) SRC = d2c( N ) /* SRC: 1 byte (local char.) */ UTF.DST = SRC /* DST: 2 or more UTF-8 bytes */ UTF.SRC = DST /* excluding us-ascii 0..127 */ end N end return xrange( x2c( 0 ), x2c( 7F )) /* -------------------------------------------------------------- */ /* RXsock.dll interface (TOPEN, TREAD, TSEND, TFAIL) + gen. RXMSG */ TOPEN: procedure expose (EXPO) /* TCP connect with HOST at PORT */ if RxFuncQuery( 'SockLoadFuncs' ) then do call RxFuncAdd 'SockLoadFuncs', 'RXSOCK', 'SockLoadFuncs' call SockLoadFuncs 'N' /* TRAP if RXSOCK.DLL not found */ end if datatype( value( 'TSOCK' ), 'w' ) then call SockClose TSOCK if sign( verify( arg( 1 ), '0.123456789' )) = 0 then do if SockGetHostByAddr( arg( 1 ), 'PEER.' ) = 0 then do PEER.ADDR = arg( 1 ) ; PEER.HOST = arg( 1 ) end /* support IP without host name: */ end /* SockConnect() handles bad IP */ else if SockGetHostByName( arg( 1 ), 'PEER.' ) = 0 then return RXMSG( 'unknown' arg( 1 ) value( 'h_errno' )) PEER.PORT = arg( 2 ) ; PEER.FAMILY = 'AF_INET' TSOCK = SockSocket( PEER.FAMILY, 'SOCK_STREAM', 'IPPROTO_TCP' ) if 0 <= TSOCK then do if SockConnect( TSOCK, 'PEER.' ) = 0 then return 0 end /* 0: okay, connected with TSOCK */ return TFAIL() /* 1: error shown, socket closed */ TREAD: procedure expose (EXPO) /* TCP read line (or data block) */ READ = '' do until N < 2000 | sign( pos( x2c( 0A ), READ )) N = SockRecv( TSOCK, 'DATA', 2000 ) if N > 0 then READ = READ || left( DATA, N ) end return READ TSEND: procedure expose (EXPO) /* TCP send complete data block */ if arg( 1, 'e' ) /* 1: any error, 0: sent / close */ then return length( arg( 1 )) <> SockSend( TSOCK, arg( 1 )) else return SockShutDown( TSOCK, 1 ) <> 0 RXMSG: procedure expose (EXPO) /* show error message & return 1 */ call SockPSock_Errno arg( 1 ) ; return 1 /* special RXMSG version writing only to STDERR without trying */ /* RxMessageBox() - the latter won't fail as expected if used */ /* with ooRexx on a Windows platform. Porting Rexx is no fun. */ TFAIL: /* close sockets and handle TRAP */ signal on novalue name TRAP ; signal on syntax name TRAP signal on failure name TRAP ; signal on halt name TRAP TRAP = RXMSG( 'socket' value( 'errno' )) if symbol( 'TSOCK' ) = 'VAR' then TRAP = SockClose( TSOCK ) if condition() = '' then return 1 /* drop into normal TRAP handler, 'sigl' + 'result' preserved: */ /* see , (c) F. Ellermann */ TRAP: /* select REXX exception handler */ call trace 'O' ; trace N /* don't trace interactive */ parse source TRAP /* source on separate line */ TRAP = x2c( 0D ) || right( '+++', 10 ) TRAP || x2c( 0D0A ) TRAP = TRAP || right( '+++', 10 ) /* = standard trace prefix */ TRAP = TRAP strip( condition( 'c' ) 'trap:' condition( 'd' )) select when wordpos( condition( 'c' ), 'ERROR FAILURE' ) > 0 then do if condition( 'd' ) > '' /* need an additional line */ then TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 ) TRAP = TRAP '(RC' rc || ')' /* any system error codes */ if condition( 'c' ) = 'FAILURE' then rc = -3 end when wordpos( condition( 'c' ), 'HALT SYNTAX' ) > 0 then do if condition( 'c' ) = 'HALT' then rc = 4 if condition( 'd' ) > '' & condition( 'd' ) <> rc then do if condition( 'd' ) <> errortext( rc ) then do TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 ) TRAP = TRAP errortext( rc ) end /* future condition( 'd' ) */ end /* may use errortext( rc ) */ else TRAP = TRAP errortext( rc ) rc = -rc /* rc < 0: REXX error code */ end when condition( 'c' ) = 'NOVALUE' then rc = -2 /* dubious */ when condition( 'c' ) = 'NOTREADY' then rc = -1 /* dubious */ otherwise /* force non-zero whole rc */ if datatype( value( 'RC' ), 'W' ) = 0 then rc = 1 if rc = 0 then rc = 1 if condition() = '' then TRAP = TRAP arg( 1 ) end /* direct: TRAP( message ) */ TRAP = TRAP || x2c( 0D0A ) || format( sigl, 6 ) signal on syntax name TRAP.SIGL /* throw syntax error 3... */ if 0 < sigl & sigl <= sourceline() /* if no handle for source */ then TRAP = TRAP '*-*' strip( sourceline( sigl )) else TRAP = TRAP '+++ (source line unavailable)' TRAP.SIGL: /* ...catch syntax error 3 */ if abbrev( right( TRAP, 2 + 6 ), x2c( 0D0A )) then do TRAP = TRAP '+++ (source line unreadable)' ; rc = -rc end select when 0 then do /* in pipes STDERR: output */ parse version TRAP.REXX /* REXX/Personal: \dev\con */ if abbrev( TRAP.REXX, 'REXXSAA ' ) | /**/ , 6 <= word( TRAP.REXX, 2 ) then TRAP.REXX = 'STDERR' else TRAP.REXX = '\dev\con' signal on syntax name TRAP.FAIL call lineout TRAP.REXX , TRAP /* fails if no more handle */ end when 1 then do /* OS/2 PM or ooREXX on NT */ signal on syntax name TRAP.FAIL call RxMessageBox translate( TRAP, ' ', x2c( 0D )), /**/ , 'Trap' time(),, 'ERROR' end otherwise say TRAP ; trace ?L /* interactive Label trace */ end if condition() = 'SIGNAL' then signal TRAP.EXIT TRAP.CALL: return rc /* continue after CALL ON */ TRAP.FAIL: say TRAP ; rc = 0 - rc /* force TRAP error output */ TRAP.EXIT: exit rc /* exit for any SIGNAL ON */