pingr/0000755000176200001440000000000013674166363011410 5ustar liggesuserspingr/NAMESPACE0000644000176200001440000000035513674140464012624 0ustar liggesusers# Generated by roxygen2: do not edit by hand export(apple_captive_test) export(is_online) export(is_up) export(my_ip) export(nsl) export(ping) export(ping_port) importFrom(processx,run) useDynLib(pingr, .registration = TRUE) pingr/LICENSE0000644000176200001440000000006313674133135012403 0ustar liggesusersYEAR: 2014-2017 COPYRIGHT HOLDER: Gábor Csárdi pingr/README.md0000644000176200001440000000537313674133135012666 0ustar liggesusers # pingr: check if a server is alive [![Linux Build Status](https://travis-ci.org/r-lib/pingr.svg?branch=master)](https://travis-ci.org/r-lib/pingr) [![Windows Build status](https://ci.appveyor.com/api/projects/status/github/r-lib/pingr?svg=true)](https://ci.appveyor.com/project/gaborcsardi/pingr) [![CRAN RStudio mirror downloads](http://cranlogs.r-pkg.org/badges/pingr)](https://r-pkg.org/pkg/pingr) The pingr package has tools to check if a remote computer or web server is up and some other related tools. ## ICMP ping The `ping()` function does ICMP ping, via the system’s `ping` utility: ``` r library(pingr) ping("127.0.0.1") ``` #> [1] 0.046 0.058 0.053 By default it sends three packets and measures the time it receives and answer. It waits between sending out the packets, so if you want a really quick check, you can just send a single packet: ``` r ping("127.0.0.1", count = 1) ``` #> [1] 0.067 If a machine is down (or it does not exist), then `NA` is returned instead of the roundtrip time: ``` r ping("192.0.2.1", count = 1) ``` #> [1] NA ## TCP ping With TCP ping we can check if a machine is listeing on a TCP port, e.g. if google’s search web server is up and running: ``` r ping_port("www.google.com", port = 80, count = 1) ``` #> [1] 12.676 ## Query the public IP address of the computer `my_ip()` queries the public IP of the computer, either via DNS or HTTPS: ``` r my_ip() ``` #> [1] "81.133.85.232" ## Check if the computer is online `is_online()` checks if the computer is online. It makes three tries: - Queries myip.opendns.com on OpenDNS, see `my_ip()`. - Retrieves icanhazip.com via HTTPS, see `my_ip()`. - Retrieve Apple’s Captive Portal test page, see `apple_captive_test()`. If any of these are successful, it returns `TRUE`. ``` r is_online() ``` #> [1] TRUE ## DNS queries The package also contains a function to perform DNS queries. This is a more portable and more functional version of the `utils::nsl()` function: ``` r nsl("www.r-project.org", type = 1L) ``` #> $answer #> name class type ttl data #> 1 www.r-project.org 1 5 900 cran.wu-wien.ac.at #> 2 cran.wu-wien.ac.at 1 1 300 137.208.57.37 #> #> $flags #> aa tc rd ra ad cd #> FALSE FALSE TRUE TRUE FALSE FALSE ``` r nsl("google.com", type = 28L) ``` #> $answer #> name class type ttl data #> 1 google.com 1 28 110 2a00:1450:4009:81a::200e #> #> $flags #> aa tc rd ra ad cd #> FALSE FALSE TRUE TRUE FALSE FALSE ## License MIT © RStudio pingr/man/0000755000176200001440000000000013674133135012152 5ustar liggesuserspingr/man/ping.Rd0000644000176200001440000000217313674140464013404 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ping-package.r \name{ping} \alias{ping} \title{Ping a remote server, to see if it is alive} \usage{ ping( destination, continuous = FALSE, verbose = continuous, count = 3L, timeout = 1 ) } \arguments{ \item{destination}{Host name or IP address.} \item{continuous}{Logical, whether to keep pinging until the user interrupts.} \item{verbose}{Whether to print progress on the screen while pinging.} \item{count}{Number of pings to perform.} \item{timeout}{Timeout for a ping response.} } \value{ Vector of response times. \code{NA} means no response, in milliseconds. Currently \code{NA}s are always at the end of the vector, and not in their correct position. } \description{ This is the classic ping, using ICMP packages. Only the system administrator can send ICMP packages, so we call out to the system's ping utility. } \examples{ \dontshow{if (pingr:::safe_examples()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} ping("8.8.8.8") ping("r-project.org") \dontshow{\}) # examplesIf} } pingr/man/nsl.Rd0000644000176200001440000000357013674140464013245 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dns.R \name{nsl} \alias{nsl} \title{DNS query} \usage{ nsl(domain, server = NULL, type = 1L, class = 1L) } \arguments{ \item{domain}{Domain to query.} \item{server}{Custom name server IP address, to use. Note that this must be an IP address currently. E.g. 8.8.8.8 is Google's DNS server.} \item{type}{Record type to query, an integer scalar. 1L is an A record, 28L is an AAAA record, etc. See e.g. https://en.wikipedia.org/wiki/List_of_DNS_record_types for the record types.} \item{class}{Query class. This is usually 1L, i.e. "Internet". See e.g. https://www.iana.org/assignments/dns-parameters/dns-parameters.xhtml#dns-parameters-2 for all DNS classes.} } \value{ A list of two entries currently, additional entries might be added later: \itemize{ \item \code{answer}: a data frame of DNS records, with columns: \code{name}, \code{class}, \code{type}, \code{ttl}, \code{data}. \code{data} is a list column and contains the IP(6) address for A and AAAA records, but it contains other data, e.g. host name for CNAME, for other records. If pingr could not parse a record (it only parses the most common records types: A, AAAA, NA, PTR, CNAME, TXT, MX, SOA), then the data of the record is included as a raw vector. \item \code{flags}: a named logical vector of flags \code{aa}, \code{tc}, \code{rd}, \code{ra}, \code{ad}, \code{cd}. See the RFC (https://www.ietf.org/rfc/rfc1035.txt) for these. On Windows they are all set to NA currently. } } \description{ Perform a DNS query for a domain. It supports custom name servers, and querying DNS records of certain class and type. } \examples{ \dontshow{if (pingr:::safe_examples()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} nsl("r-project.org") nsl("google.com", type = 28L) \dontshow{\}) # examplesIf} } pingr/man/pingr-package.Rd0000644000176200001440000000115313674133135015151 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ping-package.r \docType{package} \name{pingr-package} \alias{pingr} \alias{pingr-package} \title{Check if the local or remote computer is up} \description{ Check if a remote computer is up. It can either just call the system ping command, or check a specified TCP port. } \seealso{ Useful links: \itemize{ \item \url{https://github.com/r-lib/pingr#readme} \item Report bugs at \url{https://github.com/r-lib/pingr/issues} } } \author{ \strong{Maintainer}: Gábor Csárdi \email{csardi.gabor@gmail.com} } pingr/man/ping_port.Rd0000644000176200001440000000337013674140464014450 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ping-package.r \name{ping_port} \alias{ping_port} \alias{is_up} \title{Check if a port of a server is active, measure response time} \usage{ ping_port( destination, port = 80L, continuous = FALSE, verbose = continuous, count = 3L, timeout = 1 ) is_up( destination, port = 80, timeout = 0.5, fail_on_dns_error = FALSE, check_online = TRUE ) } \arguments{ \item{destination}{Host name or IP address.} \item{port}{Port.} \item{continuous}{Logical, whether to keep pinging until the user interrupts.} \item{verbose}{Whether to print progress on the screen while pinging.} \item{count}{Number of pings to perform.} \item{timeout}{Timeout, in seconds. How long to wait for a ping to succeed.} \item{fail_on_dns_error}{If \code{TRUE} then \code{is_up()} fails if the DNS resolution fails. Otherwise it will return \code{FALSE}.} \item{check_online}{Whether to check first if the computer is online. Otherwise it is possible that the computer is behind a proxy, that hijacks the HTTP connection to \code{destination}.} } \value{ Vector of response times, in milliseconds. \code{NA} means no response within the timeout. } \description{ Check if a port of a server is active, measure response time \code{is_up()} checks if a web server is up. } \examples{ \dontshow{if (pingr:::safe_examples()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} ping_port("r-project.org") \dontshow{\}) # examplesIf} \dontshow{if (pingr:::safe_examples()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} is_up("google.com") is_up("google.com", timeout = 0.01) \dontshow{\}) # examplesIf} } pingr/man/apple_captive_test.Rd0000644000176200001440000000123713674140464016322 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/http.R \name{apple_captive_test} \alias{apple_captive_test} \title{Download Apple's captive portal test} \usage{ apple_captive_test() } \description{ If the test page, returns "Success" that means that the computer is connected to the Internet. } \details{ Note that this function will fail if the computer is offline. Use \code{\link[=is_online]{is_online()}} to check if the computer is online. } \examples{ \dontshow{if (pingr:::safe_examples()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} apple_captive_test() \dontshow{\}) # examplesIf} } pingr/man/my_ip.Rd0000644000176200001440000000135013674140055013554 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/my-ip.R \name{my_ip} \alias{my_ip} \title{Query the computer's public IP address} \usage{ my_ip(method = c("dns", "https")) } \arguments{ \item{method}{Whether to use a DNS or HTTPS query.} } \value{ Computer's public IP address as a string. } \description{ It can use a DNS query to opendns.com, if \code{method == "dns"}, or an HTTPS query to icanhazip.com, see https://github.com/major/icanhaz. The DNS query is much faster, the HTTPS query is secure. } \examples{ \dontshow{if (pingr:::safe_examples()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} my_ip() my_ip(method = "https") \dontshow{\}) # examplesIf} } pingr/man/is_online.Rd0000644000176200001440000000175313674140464014431 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ping-package.r \name{is_online} \alias{is_online} \title{Is the computer online?} \usage{ is_online(timeout = 1) } \arguments{ \item{timeout}{Timeout for the queries. (Note: it is currently not used for the DNS query.)} } \value{ Possible values: \itemize{ \item \code{TRUE} Yes, online. \item \code{FALSE} No, not online. } } \description{ Check if the computer is online. It does three tries: \itemize{ \item Retrieve Apple's Captive Portal test page, see \code{\link[=apple_captive_test]{apple_captive_test()}}. \item Queries myip.opendns.com on OpenDNS, see \code{\link[=my_ip]{my_ip()}}. \item Retrieves icanhazip.com via HTTPS, see \code{\link[=my_ip]{my_ip()}}. If any of these are successful, it returns \code{TRUE}. } } \examples{ \dontshow{if (pingr:::safe_examples()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} is_online() \dontshow{\}) # examplesIf} } pingr/DESCRIPTION0000644000176200001440000000137613674166363013125 0ustar liggesusersPackage: pingr Title: Check if a Remote Computer is Up Version: 2.0.1 Authors@R: person(given = "Gábor", family = "Csárdi", role = c("aut", "cre"), email = "csardi.gabor@gmail.com") Description: Check if a remote computer is up. It can either just call the system ping command, or check a specified TCP port. License: MIT + file LICENSE LazyData: true URL: https://github.com/r-lib/pingr#readme BugReports: https://github.com/r-lib/pingr/issues Suggests: covr, testthat Imports: processx, utils RoxygenNote: 7.1.0.9000 Encoding: UTF-8 NeedsCompilation: yes Packaged: 2020-06-22 14:44:39 UTC; csard Author: Gábor Csárdi [aut, cre] Maintainer: Gábor Csárdi Repository: CRAN Date/Publication: 2020-06-22 17:40:03 UTC pingr/tests/0000755000176200001440000000000013674133135012541 5ustar liggesuserspingr/tests/testthat/0000755000176200001440000000000013674166363014412 5ustar liggesuserspingr/tests/testthat/test-icmp.r0000644000176200001440000000144013674133135016470 0ustar liggesusers context("ICMP") test_that("We can ping localhost", { if (Sys.getenv("APPVEYOR") == "") { pr <- ping("127.0.0.1", count = 1) expect_true(is.double(pr)) expect_true(length(pr) == 1) expect_true(pr < 1000) } }) test_that("We can ping a remote host", { if (Sys.getenv("APPVEYOR") == "") { ## Non-existent IP pr <- ping("192.0.2.1", count = 1) expect_equal(pr, NA_real_) ## Google pr <- ping("google.com", count = 1) expect_true(is.double(pr)) expect_true(length(pr) == 1) expect_true(pr < 1000) pr <- ping("8.8.8.8", count = 1) expect_true(is.double(pr)) expect_true(length(pr) == 1) expect_true(pr < 1000) } }) test_that("We don't wait too long", { ## TODO expect_true(TRUE) }) pingr/tests/testthat/test-tcp.r0000644000176200001440000000220213674133135016323 0ustar liggesusers context("TCP") test_that("We can ping localhost", { ## Chances are, there is nothing here pr <- ping_port("127.0.0.1", port = 4695, count = 1) expect_equal(pr, NA_real_) ## Start web server r_httpd_port <- if(R.version[["svn rev"]] < 67550) { try(tools::startDynamicHelp(TRUE), silent = TRUE) getFromNamespace("httpdPort", "tools") } else { tools::startDynamicHelp(NA) } pr <- ping_port("127.0.0.1", port = r_httpd_port, count = 1) expect_true(is.double(pr)) expect_true(length(pr) == 1) expect_true(pr < 1000) ## Shut down web server tools::startDynamicHelp(start = FALSE) }) test_that("We can ping a remote host", { ## There is surely nothing here pr <- ping_port("igraph.org", port = 4695, count = 1) expect_equal(pr, NA_real_) ## There is surely something here pr <- ping_port("httpbin.org", count = 1) expect_true(is.double(pr)) expect_true(length(pr) == 1) expect_true(pr < 1000) }) test_that("We don't wait too long", { ## TODO expect_true(TRUE) }) test_that("We don't wait for the resolver", { ## TODO expect_true(TRUE) }) pingr/tests/testthat.R0000644000176200001440000000014413674133135014523 0ustar liggesuserslibrary(testthat) library(pingr) if (Sys.getenv("NOT_CRAN") != "") { test_check("pingr") } pingr/src/0000755000176200001440000000000013674141727012174 5ustar liggesuserspingr/src/errors.c0000644000176200001440000000354613674133135013656 0ustar liggesusers #include "errors.h" #include #ifndef _WIN32 #include #endif #define ERRORBUF_SIZE 4096 static char errorbuf[ERRORBUF_SIZE]; SEXP r_throw_error(const char *func, const char *filename, int line, const char *msg, ...) { va_list args; va_start(args, msg); vsnprintf(errorbuf, ERRORBUF_SIZE, msg, args); va_end (args); error("%s @%s:%d (%s)", errorbuf, filename, line, func); return R_NilValue; } #ifdef _WIN32 SEXP r_throw_system_error(const char *func, const char *filename, int line, DWORD errorcode, const char *sysmsg, const char *msg, ...) { va_list args; LPVOID lpMsgBuf; char *realsysmsg = sysmsg ? (char*) sysmsg : NULL; if (errorcode == -1) errorcode = GetLastError(); if (!realsysmsg) { FormatMessage( FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, errorcode, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (LPTSTR) &lpMsgBuf, 0, NULL); realsysmsg = R_alloc(1, strlen(lpMsgBuf) + 1); strcpy(realsysmsg, lpMsgBuf); LocalFree(lpMsgBuf); } va_start(args, msg); vsnprintf(errorbuf, ERRORBUF_SIZE, msg, args); va_end(args); error("%s (system error %d, %s) @%s:%d (%s)", errorbuf, errorcode, realsysmsg, filename, line, func); return R_NilValue; } #else SEXP r_throw_system_error(const char *func, const char *filename, int line, int errorcode, const char *sysmsg, const char *msg, ...) { va_list args; if (!sysmsg) sysmsg = strerror(errorcode); va_start(args, msg); vsnprintf(errorbuf, ERRORBUF_SIZE, msg, args); va_end(args); error("%s (system error %d, %s) @%s:%d (%s)", errorbuf, errorcode, sysmsg, filename, line, func); return R_NilValue; } #endif pingr/src/init.c0000644000176200001440000000055513674133135013302 0ustar liggesusers #include #include #include "pingr.h" static const R_CallMethodDef callMethods[] = { {"r_ping", (DL_FUNC) &r_ping, 7}, {"r_nsl", (DL_FUNC) &r_nsl, 4}, {NULL, NULL, 0} }; void R_init_pingr(DllInfo *dll) { R_registerRoutines(dll, NULL, callMethods, NULL, NULL); R_useDynamicSymbols(dll, FALSE); R_forceSymbols(dll, TRUE); } pingr/src/rping.c0000644000176200001440000001245013674133135013453 0ustar liggesusers #include #include #include #include "pingr.h" #ifdef WIN32 # define WIN32_LEAN_AND_MEAN # include # include # define close closesocket # define WINSTARTUP() if (WSAStartup(MAKEWORD(2, 2), &wsaData) != 0) { \ error("Cannot initialize network"); \ } # define WINCLEANUP() WSACleanup() void usleep(__int64 usec) { HANDLE timer; LARGE_INTEGER ft; ft.QuadPart = -(10*usec); timer = CreateWaitableTimer(NULL, TRUE, NULL); SetWaitableTimer(timer, &ft, 0, NULL, NULL, 0); WaitForSingleObject(timer, INFINITE); CloseHandle(timer); } #else # include # include # include # include # include # include # define WINSTARTUP() # define WINCLEANUP() #endif #include #include #include SEXP r_ping(SEXP p_destination, SEXP p_port, SEXP p_type, SEXP p_continuous, SEXP p_verbose, SEXP p_count, SEXP p_timeout) { SEXP result; const char *destination; int port, type, continuous, verbose, count, timeout; struct in_addr ip_address; struct hostent *remote_host = NULL; int i = 0; #ifdef WIN32 WSADATA wsaData; #endif /* ---------------------------------------------------------------- */ /* Check arguments */ /* ---------------------------------------------------------------- */ if (LENGTH(p_destination) != 1) { error("destination must be a character scalar"); } if (LENGTH(p_port) != 1) { error("port must be a numeric scalar"); } if (LENGTH(p_type) != 1) { error("type must be a character scalar"); } if (LENGTH(p_continuous) != 1) { error("continuous must be a logical scalar"); } if (LENGTH(p_verbose) != 1) { error("verbose must be a logical scalar"); } if (LENGTH(p_count) != 1) { error("type must be a numeric scalar"); } if (LENGTH(p_timeout) != 1) { error("type must be a numeric scalar"); } destination = CHAR(STRING_ELT(AS_CHARACTER(p_destination), 0)); port = INTEGER(AS_INTEGER(p_port))[0]; type = INTEGER(AS_INTEGER(p_type))[0]; if (type == 0) { type = IPPROTO_TCP; } else { type = IPPROTO_UDP; } continuous = INTEGER(AS_INTEGER(p_continuous))[0]; verbose = INTEGER(AS_INTEGER(p_verbose))[0]; count = INTEGER(AS_INTEGER(p_count))[0]; timeout = INTEGER(AS_INTEGER(p_timeout))[0]; /* ---------------------------------------------------------------- */ /* Resolve host */ /* ---------------------------------------------------------------- */ WINSTARTUP(); remote_host = gethostbyname(destination); if (!remote_host) { error("Cannot resolve host name"); } ip_address = *(struct in_addr*) remote_host->h_addr_list[0]; WINCLEANUP(); if (verbose) { Rprintf("TCP PING %s (%s) Port:\n", destination, inet_ntoa(ip_address), port); } /* ---------------------------------------------------------------- */ /* Main ping loop */ /* ---------------------------------------------------------------- */ PROTECT(result = NEW_NUMERIC(count)); while (1) { /* Try to connect */ struct timeval tv, start, stop; double t_start, t_stop; struct sockaddr_in c_address; fd_set read, write; int c_socket, ret; double time; #ifdef WIN32 u_long imode = 1; #endif WINSTARTUP(); c_socket = socket(AF_INET, type == IPPROTO_UDP ? SOCK_DGRAM : SOCK_STREAM, type); if (c_socket == -1) { WINCLEANUP(); error("Cannot connect to host"); } c_address.sin_addr = ip_address; c_address.sin_family = AF_INET; c_address.sin_port = htons(port); tv.tv_sec = timeout / 1000000; tv.tv_usec = timeout % 1000000; gettimeofday(&start, NULL); /* Set non-blocking */ #ifdef WIN32 ioctlsocket(c_socket, FIONBIO, &imode); #else if (fcntl(c_socket, F_SETFL, O_NONBLOCK) < 0) { error("Cannot set socket to non-blocking"); } #endif ret = connect(c_socket, (const struct sockaddr*) &c_address, sizeof(c_address)); #ifdef WIN32 ret = WSAGetLastError(); if (ret != WSAEWOULDBLOCK && ret != 0) { error("Cannot connect"); } #else if (ret < 0 && errno != EINPROGRESS) { error("Cannot connect"); } #endif FD_ZERO(&read); FD_ZERO(&write); FD_SET(c_socket, &read); FD_SET(c_socket, &write); ret = select(c_socket + 1, &read, &write, NULL, &tv); if (ret != 1) { close(c_socket); time = NA_REAL; } else { gettimeofday(&stop, NULL); t_start = start.tv_usec + start.tv_sec * 1000000; t_stop = stop.tv_usec + stop.tv_sec * 1000000; time = (t_stop - t_start) / 1000; } if (!FD_ISSET(c_socket, &read) && !FD_ISSET(c_socket, &write)) { close(c_socket); time = NA_REAL; } REAL(result)[i] = time; close(c_socket); WINCLEANUP(); if (verbose) { if (ISNA(time)) { Rprintf("Request timeout for package %i\n", i + 1); } else { Rprintf("From %s: ping=%i time=%.3f ms\n", destination, i + 1, time); } } /* Are we done? */ i++; if (!continuous && i == count) { break; } R_CheckUserInterrupt(); /* No, wait a bit then */ usleep((1000 - time) * 1000); } UNPROTECT(1); return result; } pingr/src/Makevars0000644000176200001440000000002413674133135013656 0ustar liggesusersPKG_LIBS = -lresolv pingr/src/pingr.h0000644000176200001440000000042713674133135013461 0ustar liggesusers #ifndef R_PINGR_H #define R_PINGR_H #include #include SEXP r_ping(SEXP p_destination, SEXP p_port, SEXP p_type, SEXP p_continuous, SEXP p_verbose, SEXP p_count, SEXP p_timeout); SEXP r_nsl(SEXP hostname, SEXP server, SEXP class, SEXP type); #endif pingr/src/Makevars.win0000644000176200001440000000003513674133135014454 0ustar liggesusersPKG_LIBS = -lws2_32 -ldnsapi pingr/src/dns.c0000644000176200001440000003225613674133135013126 0ustar liggesusers #ifdef _WIN32 #include #include #endif #undef ERROR #include "pingr.h" #include "errors.h" #ifdef _WIN32 #include #include #define AF_INET6 23 #define NS_IN6ADDRSZ 16 #define NS_INT16SZ 2 // Copyright notice for inet_ntop4 and inet_ntop6 /* * Copyright (c) 1996-1999 by Internet Software Consortium. * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND INTERNET SOFTWARE CONSORTIUM DISCLAIMS * ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL INTERNET SOFTWARE * CONSORTIUM BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL * DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR * PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS * ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS * SOFTWARE. */ static const char *inet_ntop4 (const u_char *src, char *dst, size_t size) { static const char fmt[] = "%u.%u.%u.%u"; char tmp[sizeof "255.255.255.255"]; if (sprintf(tmp, fmt, src[0], src[1], src[2], src[3]) >= size) { R_THROW_ERROR("Cannot parse IPv4 address"); } return strcpy(dst, tmp); } static const char *inet_ntop6 (const u_char *src, char *dst, size_t size) { /* * Note that int32_t and int16_t need only be "at least" large enough * to contain a value of the specified size. On some systems, like * Crays, there is no such thing as an integer variable with 16 bits. * Keep this in mind if you think this function should have been coded * to use pointer overlays. All the world's not a VAX. */ char tmp[sizeof "ffff:ffff:ffff:ffff:ffff:ffff:255.255.255.255"], *tp; struct { int base, len; } best, cur; u_int words[NS_IN6ADDRSZ / NS_INT16SZ]; int i; /* * Preprocess: * Copy the input (bytewise) array into a wordwise array. * Find the longest run of 0x00's in src[] for :: shorthanding. */ memset(words, '\0', sizeof words); for (i = 0; i < NS_IN6ADDRSZ; i += 2) words[i / 2] = (src[i] << 8) | src[i + 1]; best.base = -1; cur.base = -1; best.len = 0; cur.len = 0; for (i = 0; i < (NS_IN6ADDRSZ / NS_INT16SZ); i++) { if (words[i] == 0) { if (cur.base == -1) cur.base = i, cur.len = 1; else cur.len++; } else { if (cur.base != -1) { if (best.base == -1 || cur.len > best.len) best = cur; cur.base = -1; } } } if (cur.base != -1) { if (best.base == -1 || cur.len > best.len) best = cur; } if (best.base != -1 && best.len < 2) best.base = -1; /* * Format the result. */ tp = tmp; for (i = 0; i < (NS_IN6ADDRSZ / NS_INT16SZ); i++) { /* Are we inside the best run of 0x00's? */ if (best.base != -1 && i >= best.base && i < (best.base + best.len)) { if (i == best.base) *tp++ = ':'; continue; } /* Are we following an initial run of 0x00s or any real hex? */ if (i != 0) *tp++ = ':'; /* Is this address an encapsulated IPv4? */ if (i == 6 && best.base == 0 && (best.len == 6 || (best.len == 5 && words[5] == 0xffff))) { if (!inet_ntop4(src+12, tp, sizeof tmp - (tp - tmp))) return (NULL); tp += strlen(tp); break; } tp += sprintf(tp, "%x", words[i]); } /* Was it a trailing run of 0x00's? */ if (best.base != -1 && (best.base + best.len) == (NS_IN6ADDRSZ / NS_INT16SZ)) *tp++ = ':'; *tp++ = '\0'; /* * Check for overflow, copy, and we're done. */ if ((socklen_t)(tp - tmp) > size) { R_THROW_ERROR("Cannot parse IPv6 address"); } return strcpy(dst, tmp); } SEXP r_nsl(SEXP hostname, SEXP server, SEXP class, SEXP type) { PDNS_RECORD response, ptr; DNS_STATUS ret; PIP4_ARRAY pSrvList = NULL; IN_ADDR ipaddr; int cnt = 0; const char *resnames[] = { "answer", "flags", "" }; const char *recnames[] = { "name", "class", "type", "ttl", "data", "" }; const char *flagnames[] = { "aa", "tc", "rd", "ra", "ad", "cd", "" }; SEXP result = PROTECT(mkNamed(VECSXP, resnames)); SEXP records = PROTECT(mkNamed(VECSXP, recnames)); SEXP row_names = PROTECT(Rf_allocVector(INTSXP, 2)); Rf_setAttrib(records, R_ClassSymbol, mkString("data.frame")); SET_VECTOR_ELT(result, 0, records); SET_VECTOR_ELT(result, 1, mkNamed(LGLSXP, flagnames)); if (!isNull(server)) { pSrvList = (PIP4_ARRAY) LocalAlloc(LPTR,sizeof(IP4_ARRAY)); if (!pSrvList) R_THROW_ERROR("DNS query failed, out of memory"); pSrvList->AddrCount = 1; pSrvList->AddrArray[0] = inet_addr(CHAR(STRING_ELT(server, 0))); } ret = DnsQuery_A( CHAR(STRING_ELT(hostname, 0)), INTEGER(type)[0], DNS_QUERY_STANDARD, pSrvList, &response, NULL ); if (ret) R_THROW_SYSTEM_ERROR_CODE(ret, "DNS query failed"); ptr = response; while (ptr) { cnt ++; ptr = ptr->pNext; } SET_VECTOR_ELT(records, 0, Rf_allocVector(STRSXP, cnt)); SET_VECTOR_ELT(records, 1, Rf_allocVector(INTSXP, cnt)); SET_VECTOR_ELT(records, 2, Rf_allocVector(INTSXP, cnt)); SET_VECTOR_ELT(records, 3, Rf_allocVector(INTSXP, cnt)); SET_VECTOR_ELT(records, 4, Rf_allocVector(VECSXP, cnt)); INTEGER(row_names)[0] = NA_INTEGER; INTEGER(row_names)[1] = -cnt; Rf_setAttrib(records, R_RowNamesSymbol, row_names); LOGICAL(VECTOR_ELT(result, 1))[0] = NA_LOGICAL; LOGICAL(VECTOR_ELT(result, 1))[1] = NA_LOGICAL; LOGICAL(VECTOR_ELT(result, 1))[2] = NA_LOGICAL; LOGICAL(VECTOR_ELT(result, 1))[3] = NA_LOGICAL; LOGICAL(VECTOR_ELT(result, 1))[4] = NA_LOGICAL; LOGICAL(VECTOR_ELT(result, 1))[5] = NA_LOGICAL; ptr = response; cnt = 0; while (ptr) { char buf[1025]; int raw = 0; SEXP rawdata; SET_STRING_ELT(VECTOR_ELT(records, 0), cnt, mkChar(ptr->pName)); INTEGER(VECTOR_ELT(records, 1))[cnt] = 1L; INTEGER(VECTOR_ELT(records, 2))[cnt] = (int) ptr->wType; INTEGER(VECTOR_ELT(records, 3))[cnt] = (int) ptr->dwTtl; switch(ptr->wType) { case DNS_TYPE_A: inet_ntop4((u_char*) &(ptr->Data.A.IpAddress), buf, sizeof buf); break; case DNS_TYPE_AAAA: inet_ntop6((u_char*) &(ptr->Data.AAAA.Ip6Address), buf, sizeof buf); break; case DNS_TYPE_NS: case DNS_TYPE_PTR: case DNS_TYPE_CNAME: snprintf(buf, sizeof buf, "%s", ptr->Data.PTR.pNameHost); break; case DNS_TYPE_TEXT: snprintf(buf, sizeof buf, "%s", ptr->Data.TXT.pStringArray[0]); break; case DNS_TYPE_MX: snprintf(buf, sizeof buf, "%s", ptr->Data.MX.pNameExchange); break; case DNS_TYPE_SOA: snprintf(buf, sizeof buf, "%s. %s. %u %u %u %u %u", ptr->Data.SOA.pNamePrimaryServer, ptr->Data.SOA.pNameAdministrator, ptr->Data.SOA.dwSerialNo, ptr->Data.SOA.dwRefresh, ptr->Data.SOA.dwRetry, ptr->Data.SOA.dwExpire, ptr->Data.SOA.dwDefaultTtl); break; default: raw = 1; rawdata = PROTECT(Rf_allocVector(RAWSXP, ptr->wDataLength)); SET_VECTOR_ELT(VECTOR_ELT(records, 4), cnt, rawdata); UNPROTECT(1); memcpy(RAW(rawdata), &(ptr->Data.A), ptr->wDataLength); break; } if (!raw) SET_VECTOR_ELT(VECTOR_ELT(records, 4), cnt, mkString(buf)); cnt++; ptr = ptr->pNext; } /* TODO: these leak on error, we would need to use cleancall */ LocalFree(pSrvList); DnsRecordListFree(response, DnsFreeRecordList); UNPROTECT(3); return result; } #else #include #include #include #include #include #ifdef __sun #define u_int16_t uint16_t #define u_int32_t uint32_t static int xxns_name_uncompress(const u_char *msg, const u_char *eom, const u_char *src, char *dst, size_t dstsiz) { u_char tmp[NS_MAXCDNAME]; int n; if ((n = ns_name_unpack(msg, eom, src, tmp, sizeof tmp)) == -1) return -1; if (ns_name_ntop(tmp, dst, dstsiz) == -1) return -1; return n; } #else #define xxns_name_uncompress ns_name_uncompress #endif // See https://docstore.mik.ua/orelly/networking_2ndEd/dns/ch15_02.htm // for the documentation of the ns_* functions, because these are // otherwise undocumented. SEXP r_nsl(SEXP hostname, SEXP server, SEXP class, SEXP type) { int ret; unsigned char answer[64 * 1024]; ns_msg msg; u_int16_t i, cnt; const char *resnames[] = { "answer", "flags", "" }; const char *recnames[] = { "name", "class", "type", "ttl", "data", "" }; const char *flagnames[] = { "aa", "tc", "rd", "ra", "ad", "cd", "" }; SEXP result = PROTECT(mkNamed(VECSXP, resnames)); SEXP records = PROTECT(mkNamed(VECSXP, recnames)); SEXP row_names = PROTECT(Rf_allocVector(INTSXP, 2)); Rf_setAttrib(records, R_ClassSymbol, mkString("data.frame")); SET_VECTOR_ELT(result, 0, records); SET_VECTOR_ELT(result, 1, mkNamed(LGLSXP, flagnames)); ret = res_init(); if (ret) R_THROW_SYSTEM_ERROR("Failed to initialize resolver library"); if (!isNull(server)) { struct in_addr addr; ret = inet_pton(AF_INET, CHAR(STRING_ELT(server, 0)), &addr); _res.options &= ~(RES_DNSRCH | RES_DEFNAMES); _res.nscount = LENGTH(server); _res.nsaddr_list[0].sin_addr = addr; } ret = res_query( CHAR(STRING_ELT(hostname, 0)), INTEGER(class)[0], INTEGER(type)[0], answer, sizeof answer); if (ret == -1) R_THROW_SYSTEM_ERROR("DNS query failed"); ret = ns_initparse(answer, ret, &msg); if (ret == -1) R_THROW_SYSTEM_ERROR("Cannot parse DNS answer"); LOGICAL(VECTOR_ELT(result, 1))[0] = ns_msg_getflag(msg, ns_f_aa); LOGICAL(VECTOR_ELT(result, 1))[1] = ns_msg_getflag(msg, ns_f_tc); LOGICAL(VECTOR_ELT(result, 1))[2] = ns_msg_getflag(msg, ns_f_rd); LOGICAL(VECTOR_ELT(result, 1))[3] = ns_msg_getflag(msg, ns_f_ra); LOGICAL(VECTOR_ELT(result, 1))[4] = ns_msg_getflag(msg, ns_f_ad); LOGICAL(VECTOR_ELT(result, 1))[5] = ns_msg_getflag(msg, ns_f_cd); cnt = ns_msg_count(msg, ns_s_an); SET_VECTOR_ELT(records, 0, Rf_allocVector(STRSXP, cnt)); SET_VECTOR_ELT(records, 1, Rf_allocVector(INTSXP, cnt)); SET_VECTOR_ELT(records, 2, Rf_allocVector(INTSXP, cnt)); SET_VECTOR_ELT(records, 3, Rf_allocVector(INTSXP, cnt)); SET_VECTOR_ELT(records, 4, Rf_allocVector(VECSXP, cnt)); INTEGER(row_names)[0] = NA_INTEGER; INTEGER(row_names)[1] = -cnt; Rf_setAttrib(records, R_RowNamesSymbol, row_names); for (i = 0; i < cnt; i++) { ns_rr rec; u_int16_t class, type; u_int16_t mx; u_int32_t soa[5]; const u_char *data; char buf[NS_MAXDNAME]; int raw = 0; SEXP rawdata; ret = ns_parserr(&msg, ns_s_an, i, &rec); if (ret == -1) R_THROW_SYSTEM_ERROR("Cannot parse DNS record"); class = ns_rr_class(rec); type = ns_rr_type(rec); data = ns_rr_rdata(rec); SET_STRING_ELT(VECTOR_ELT(records, 0), i, mkChar(ns_rr_name(rec))); INTEGER(VECTOR_ELT(records, 1))[i] = (int) class; INTEGER(VECTOR_ELT(records, 2))[i] = (int) type; INTEGER(VECTOR_ELT(records, 3))[i] = (int) ns_rr_ttl(rec); ret = 0; switch (type) { case ns_t_a: inet_ntop(AF_INET, data, buf, sizeof buf); break; case ns_t_aaaa: inet_ntop(AF_INET6, data, buf, sizeof buf); break; case ns_t_ns: case ns_t_ptr: case ns_t_cname: ret = xxns_name_uncompress(ns_msg_base(msg), ns_msg_end(msg), data, buf, sizeof buf); break; case ns_t_txt: snprintf(buf, (size_t) data[0]+1, "%s", data + 1); break; case ns_t_mx: NS_GET16(mx, data); ret = xxns_name_uncompress(ns_msg_base(msg), ns_msg_end(msg), data, buf, sizeof buf); break; case ns_t_soa: { char *buf2 = buf; size_t bufsize = sizeof buf; int len, j; ret = xxns_name_uncompress(ns_msg_base(msg), ns_msg_end(msg), data, buf, sizeof buf); if (ret < 0) R_THROW_SYSTEM_ERROR("Cannot parse SOA DNS record"); data += ret; len = strlen(buf2); buf2 += len; bufsize -= len; if (bufsize > 2) { *buf2 = '.'; buf2++; bufsize--; *buf2 = ' '; buf2++; bufsize--; } ret = xxns_name_uncompress(ns_msg_base(msg), ns_msg_end(msg), data, buf2, bufsize); if (ret < 0) R_THROW_SYSTEM_ERROR("Cannot parse SOA DNS record"); data += ret; len = strlen(buf2); buf2 += len; bufsize -= len; if (bufsize > 2) { *buf2 = '.'; buf2++; bufsize--; *buf2 = ' '; buf2++; bufsize--; } if (ns_msg_end(msg) - data < 5*NS_INT32SZ) { R_THROW_ERROR("Cannot parse SOA DNS record"); } for (j = 0; j < 5; j++) NS_GET32(soa[j], data); snprintf(buf2, bufsize, "%u %u %u %u %u", soa[0], soa[1], soa[2], soa[3], soa[4]); break; } default: raw = 1; rawdata = PROTECT(Rf_allocVector(RAWSXP, ns_rr_rdlen(rec))); SET_VECTOR_ELT(VECTOR_ELT(records, 4), i, rawdata); UNPROTECT(1); memcpy(RAW(rawdata), ns_rr_rdata(rec), ns_rr_rdlen(rec)); break; } if (ret < 0) { R_THROW_SYSTEM_ERROR("Cannot parse NS/PTR/CNAME DNS record"); } if (!raw) SET_VECTOR_ELT(VECTOR_ELT(records, 4), i, mkString(buf)); } UNPROTECT(3); return result; } #endif pingr/src/errors.h0000644000176200001440000000246313674133135013660 0ustar liggesusers #ifndef R_THROW_ERROR_H #define R_THROW_ERROR_H #ifndef _GNU_SOURCE #define _GNU_SOURCE 1 #endif #ifdef _WIN32 #include #else #include #endif #include #define R_THROW_ERROR(...) \ r_throw_error(__func__, __FILE__, __LINE__, __VA_ARGS__) SEXP r_throw_error(const char *func, const char *filename, int line, const char *msg, ...); #ifdef _WIN32 #define R_THROW_SYSTEM_ERROR(...) \ r_throw_system_error(__func__, __FILE__, __LINE__, (-1), NULL, __VA_ARGS__) #define R_THROW_SYSTEM_ERROR_CODE(errorcode, ...) \ r_throw_system_error(__func__, __FILE__, __LINE__, (errorcode), NULL, __VA_ARGS__) SEXP r_throw_system_error(const char *func, const char *filename, int line, DWORD errorcode, const char *sysmsg, const char *msg, ...); #else #define R_THROW_SYSTEM_ERROR(...) \ r_throw_system_error(__func__, __FILE__, __LINE__, errno, NULL, __VA_ARGS__) #define R_THROW_SYSTEM_ERROR_CODE(errorcode, ...) \ r_throw_system_error(__func__, __FILE__, __LINE__, errorcode, NULL, __VA_ARGS__) SEXP r_throw_system_error(const char *func, const char *filename, int line, int errorcode, const char *sysmsg, const char *msg, ...); #endif #endif pingr/R/0000755000176200001440000000000013674133135011600 5ustar liggesuserspingr/R/http.R0000644000176200001440000000142613674140323012702 0ustar liggesusers http_get <- function(url) { tmp <- tempfile() on.exit(unlink(tmp, recursive = TRUE), add = TRUE) suppressWarnings(utils::download.file(url, tmp, quiet = TRUE)) if (!file.exists(tmp)) stop("Cannot download `", url, "`") readChar(tmp, file.info(tmp)$size, useBytes = TRUE) } #' Download Apple's captive portal test #' #' If the test page, returns "Success" that means that the computer is #' connected to the Internet. #' #' Note that this function will fail if the computer is offline. Use #' [is_online()] to check if the computer is online. #' #' @export #' @examplesIf pingr:::safe_examples() #' apple_captive_test() apple_captive_test <- function() { out <- http_get("http://captive.apple.com/hotspot-detect.html") grepl("Success", out) } pingr/R/utils.r0000644000176200001440000000111413674140225013116 0ustar liggesusers int <- as.integer is_string <- function(x) { is.character(x) && length(x) == 1 && !is.na(x) } is_string_or_null <- function(x) { is.null(x) || is_string(x) } is_count <- function(x) { is.integer(x) && length(x) == 1 && !is.na(x) } is_type <- function(x) { is_count(x) } is_class <- function(x) { is_count(x) } safe_examples <- function() { !is_cran_check() && is_online() } is_cran_check <- function () { if (identical(Sys.getenv("NOT_CRAN"), "true")) { FALSE } else { Sys.getenv("_R_CHECK_PACKAGE_NAME_", "") != "" } } pingr/R/my-ip.R0000644000176200001440000000224013674140050012746 0ustar liggesusers #' Query the computer's public IP address #' #' It can use a DNS query to opendns.com, if `method == "dns"`, or #' an HTTPS query to icanhazip.com, see https://github.com/major/icanhaz. #' The DNS query is much faster, the HTTPS query is secure. #' #' @param method Whether to use a DNS or HTTPS query. #' @return Computer's public IP address as a string. #' #' @export #' @examplesIf pingr:::safe_examples() #' my_ip() #' my_ip(method = "https") my_ip <- function(method = c("dns", "https")) { method <- match.arg(method) if (method == "dns") my_ip_dns() else my_ip_https() } my_ip_dns <- function() { out <- nsl("myip.opendns.com", server = "208.67.222.222", type = 1L) if (nrow(out$answer) != 1 || out$answer$type != 1L || !is_ip_address(out$answer$data[[1]])) { stop("Cannot query my iP address via DNS") } out$answer$data[[1]] } is_ip_address <- function(x) { grepl("^[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+$", x) } my_ip_https <- function() { out <- http_get("https://ipv4.icanhazip.com/") out <- gsub("\\s+", "", out) if (!is_ip_address(out)) stop("Cannot query my IP address via https") out } pingr/R/dns.R0000644000176200001440000000350713674140337012516 0ustar liggesusers #' DNS query #' #' Perform a DNS query for a domain. It supports custom name servers, #' and querying DNS records of certain class and type. #' #' @param domain Domain to query. #' @param server Custom name server IP address, to use. Note that this #' must be an IP address currently. E.g. 8.8.8.8 is Google's DNS server. #' @param type Record type to query, an integer scalar. 1L is an A record, #' 28L is an AAAA record, etc. See e.g. #' https://en.wikipedia.org/wiki/List_of_DNS_record_types for the record #' types. #' @param class Query class. This is usually 1L, i.e. "Internet". See e.g. #' https://www.iana.org/assignments/dns-parameters/dns-parameters.xhtml#dns-parameters-2 #' for all DNS classes. #' @return A list of two entries currently, additional entries might be #' added later: #' * `answer`: a data frame of DNS records, with columns: #' `name`, `class`, `type`, `ttl`, `data`. `data` is a list column and #' contains the IP(6) address for A and AAAA records, but it contains #' other data, e.g. host name for CNAME, for other records. If pingr #' could not parse a record (it only parses the most common records #' types: A, AAAA, NA, PTR, CNAME, TXT, MX, SOA), then the data of #' the record is included as a raw vector. #' * `flags`: a named logical vector of flags `aa`, `tc`, `rd`, `ra`, #' `ad`, `cd`. See the RFC (https://www.ietf.org/rfc/rfc1035.txt) for #' these. On Windows they are all set to NA currently. #' #' @export #' @examplesIf pingr:::safe_examples() #' nsl("r-project.org") #' nsl("google.com", type = 28L) nsl <- function(domain, server = NULL, type = 1L, class = 1L) { stopifnot( is_string(domain), is_string_or_null(server), is_type(type), is_class(class) ) .Call(r_nsl, domain, server, class, type) } pingr/R/ping-package.r0000644000176200001440000001333713674140446014323 0ustar liggesusers #' Check if the local or remote computer is up #' #' @useDynLib pingr, .registration = TRUE "_PACKAGE" #' Check if a port of a server is active, measure response time #' #' @param destination Host name or IP address. #' @param port Port. #' @param continuous Logical, whether to keep pinging until #' the user interrupts. #' @param verbose Whether to print progress on the screen while #' pinging. #' @param count Number of pings to perform. #' @param timeout Timeout, in seconds. How long to wait for a #' ping to succeed. #' @return Vector of response times, in milliseconds. #' \code{NA} means no response within the timeout. #' #' @export #' @examplesIf pingr:::safe_examples() #' ping_port("r-project.org") ping_port <- function(destination, port = 80L, continuous = FALSE, verbose = continuous, count = 3L, timeout = 1.0) { type <- "tcp" type <- switch(type, "tcp" = 0L, "udp" = 1L) timeout <- as.integer(timeout * 1000000) res <- .Call(r_ping, destination, port, type, continuous, verbose, count, timeout) res[ res == -1 ] <- NA_real_ res } #' Ping a remote server, to see if it is alive #' #' This is the classic ping, using ICMP packages. Only the #' system administrator can send ICMP packages, so we call out #' to the system's ping utility. #' #' @param destination Host name or IP address. #' @param continuous Logical, whether to keep pinging until the #' user interrupts. #' @param verbose Whether to print progress on the screen while #' pinging. #' @param count Number of pings to perform. #' @param timeout Timeout for a ping response. #' @return Vector of response times. \code{NA} means no response, in #' milliseconds. Currently \code{NA}s are always at the end of the vector, #' and not in their correct position. #' #' @export #' @importFrom processx run #' @examplesIf pingr:::safe_examples() #' ping("8.8.8.8") #' ping("r-project.org") ping <- function(destination, continuous = FALSE, verbose = continuous, count = 3L, timeout = 1.0) { if (!continuous && verbose) { stop("'!continuous' && 'verbose' does not work currently") } os <- ping_os(destination, continuous, count, timeout) status <- run(os$cmd[1], os$cmd[-1], error_on_status = FALSE) output <- strsplit(status$stdout, "\r?\n")[[1]] if (!continuous) { timings <- grep(os$regex, output, value = TRUE, perl = TRUE) times <- sub(os$regex, "\\1", timings, perl = TRUE) res <- as.numeric(times) length(res) <- count res } else { invisible() } } ping_os <- function(destination, continuous, count, timeout) { if (.Platform$OS.type == "windows") { ping_file <- file.path("C:", "windows", "system32", "ping.exe") if (!file.exists(ping_file)) { ping_file <- "ping" } cmd <- c( ping_file, "-w", int(timeout * 1000), if (continuous) "-t" else c("-n", count), destination ) } else if (Sys.info()["sysname"] == "Darwin") { cmd <- c( "/sbin/ping", "-W", int(timeout * 1000), if (!continuous) c("-c", count), destination ) } else if (Sys.info()[["sysname"]] == "Linux") { cmd <- c( "ping", "-W", int(timeout), if (!continuous) c("-c", count), destination ) } else if (Sys.info()[["sysname"]] == "SunOS") { if (timeout != 1.0) { warning("Ping `timeout` is not supported on Solaris") } cmd <- c( "/usr/sbin/ping", "-s", destination, if (!continuous) c("56", count) ) } else if (.Platform$OS.type == "unix") { cmd <- c( "ping", "-W", int(timeout * 1000), if (!continuous) c("-c", count), destination ) } list(cmd = cmd, regex = "^.*time=(.+)[ ]?ms.*$") } #' Is the computer online? #' #' Check if the computer is online. It does three tries: #' * Retrieve Apple's Captive Portal test page, see [apple_captive_test()]. #' * Queries myip.opendns.com on OpenDNS, see [my_ip()]. #' * Retrieves icanhazip.com via HTTPS, see [my_ip()]. #' If any of these are successful, it returns `TRUE`. #' #' @param timeout Timeout for the queries. (Note: it is currently not #' used for the DNS query.) #' @return Possible values: \itemize{ #' \item \code{TRUE} Yes, online. #' \item \code{FALSE} No, not online. #' } #' #' @export #' @examplesIf pingr:::safe_examples() #' is_online() is_online <- function(timeout = 1) { opts <- options(timeout = timeout) on.exit(options(opts), add = TRUE) tryCatch({ if (apple_captive_test()) return(TRUE) }, error = function(e) NULL) tryCatch({ my_ip(method = "dns") return(TRUE) }, error = function(e) NULL) tryCatch({ my_ip(method = "https") return(TRUE) }, error = function(e) NULL) FALSE } #' `is_up()` checks if a web server is up. #' #' @rdname ping_port #' @param fail_on_dns_error If `TRUE` then `is_up()` fails if the DNS #' resolution fails. Otherwise it will return `FALSE`. #' @param check_online Whether to check first if the computer is online. #' Otherwise it is possible that the computer is behind a proxy, that #' hijacks the HTTP connection to `destination`. #' @export #' @examplesIf pingr:::safe_examples() #' is_up("google.com") #' is_up("google.com", timeout = 0.01) is_up <- function(destination, port = 80, timeout = 0.5, fail_on_dns_error = FALSE, check_online = TRUE) { if (check_online && ! is_online(timeout)) return(FALSE) tryCatch( !is.na(ping_port(destination, port = port, timeout = timeout, count = 1)), error = function(e) { if (fail_on_dns_error) stop(e) FALSE }) } pingr/NEWS.md0000644000176200001440000000216113674141622012475 0ustar liggesusers # 2.0.1 * `is_online()` now tries the Apple captive test first, because it works better when DNS is not masked, but HTTP is (#13). # 2.0.0 * New `nsl()` function to perform DNS queries. * New `my_ip()` function to query the computer's public IP address. * New `apple_captive_test()` function to check Apple's captive test web page to see if the computer is online. * Better `is_online()` implementation, it uses DNS and HTTPS instead of an ICMP ping via an external ping program. * Now `ip_up()` checks first if the computer is connected to the internet, via `is_online()`. # 1.2.0 * New `is_up()` function to check if a web (other other TCP) server is up. * Timeout now works correctly on Linux systems (#7). * `ping()` uses processx now to run the external ping program, so the the ping error messages do not litter the R console (#8, #9). # 1.1.2 No user visible changes. # 1.1.0 * New `is_online()` function to check if the computer is online, by pinging two DNS servers. * TCP Timeout now works for the connect phase as well. # 1.0.0 First release on CRAN. pingr/MD50000644000176200001440000000247613674166363011731 0ustar liggesusers7ba034bddbda56ad43f42236a6a31813 *DESCRIPTION 20aba98be26a539c413d3073f1d30ce0 *LICENSE 5c2d1a4d16f8554c9a5e5b181278a51f *NAMESPACE 25a85aed954b81869a4ad26a7046ee51 *NEWS.md 12591c51ff30a68d410dd3fb412ef336 *R/dns.R 0653dcd0be788a9efb14c2d772ba0ecb *R/http.R f7fd6c5c1b0b40bdde0b9256196b84dd *R/my-ip.R 6b2b0573f72f4362723fb090342028fe *R/ping-package.r 10aee2e213c2c6bae0421477b6c44fc1 *R/utils.r 89de45a7c14e622df374f2c29f26d7bb *README.md aacc2ca3c7347397fdea80e0ce3765f1 *man/apple_captive_test.Rd 9d57c548b79863e202925b484ed9aad4 *man/is_online.Rd 849e0a24600cac35bb8595febc980da9 *man/my_ip.Rd 68b4e73e06bec3c058010c7657ef40c4 *man/nsl.Rd 3ed033c320eb8e5e0588ee879efbf1cd *man/ping.Rd 98f5412b4c67113afddf8b6618d9995b *man/ping_port.Rd 08b216de1e96d860223dfef65315fa92 *man/pingr-package.Rd 13b00666c49b683c1681bc076643720f *src/Makevars 86529b4f6073e314e08a877b2dc33924 *src/Makevars.win 09f4d643b3c56053d62c95f0f2ff266d *src/dns.c b93d80937ba99d9456869e4f446e7d6d *src/errors.c d96005dff3d1900216099ce2a94eda19 *src/errors.h 7946d96fd1589d42944976739c2335bf *src/init.c cbb7e0e14198be4765ce6935a403aabc *src/pingr.h 1eab4588c9b76bcb108aab85c1667e24 *src/rping.c 6594db38738bb836db0db4018b91f8a5 *tests/testthat.R 437764661d95641157c017e9b64a45bd *tests/testthat/test-icmp.r 94bcac172005da5b50018d94e2534f89 *tests/testthat/test-tcp.r