├── .Rbuildignore ├── .github ├── .gitignore ├── CODE_OF_CONDUCT.md └── workflows │ ├── R-CMD-check.yaml │ ├── dragonflybsd.yaml │ ├── freebsd.yaml │ ├── musl.yaml │ ├── netbsd.yaml │ ├── openbsd.yaml │ ├── pkgdown.yaml │ ├── pr-commands.yaml │ └── test-coverage.yaml ├── .gitignore ├── .vscode ├── extensions.json └── settings.json ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── NAMESPACE ├── NEWS.md ├── R ├── dns.R ├── http.R ├── my-ip.R ├── ping-package.R ├── pingr-package.R └── utils.R ├── README.Rmd ├── README.md ├── _pkgdown.yml ├── air.toml ├── cleanup ├── codecov.yml ├── configure ├── configure.win ├── man ├── apple_captive_test.Rd ├── is_online.Rd ├── my_ip.Rd ├── nsl.Rd ├── ping.Rd ├── ping_port.Rd └── pingr-package.Rd ├── pingr.Rproj ├── src ├── Makevars.in ├── Makevars.win ├── dns.c ├── errors.c ├── errors.h ├── init.c ├── pingr.h └── rping.c └── tests ├── testthat.R └── testthat ├── test-icmp.R └── test-tcp.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^\.travis\.yml$ 2 | ^tags$ 3 | ^Makefile$ 4 | ^appveyor.yml$ 5 | ^.travis.yml$ 6 | ^README.Rmd$ 7 | ^\.Rprofile$ 8 | ^r-packages$ 9 | ^revdep$ 10 | ^.*\.Rproj$ 11 | ^\.Rproj\.user$ 12 | ^LICENSE\.md$ 13 | ^_pkgdown\.yml$ 14 | ^docs$ 15 | ^pkgdown$ 16 | ^\.github$ 17 | ^codecov\.yml$ 18 | ^src/Makevars$ 19 | ^[\.]?air\.toml$ 20 | ^\.vscode$ 21 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | We as members, contributors, and leaders pledge to make participation in our 6 | community a harassment-free experience for everyone, regardless of age, body 7 | size, visible or invisible disability, ethnicity, sex characteristics, gender 8 | identity and expression, level of experience, education, socio-economic status, 9 | nationality, personal appearance, race, caste, color, religion, or sexual 10 | identity and orientation. 11 | 12 | We pledge to act and interact in ways that contribute to an open, welcoming, 13 | diverse, inclusive, and healthy community. 14 | 15 | ## Our Standards 16 | 17 | Examples of behavior that contributes to a positive environment for our 18 | community include: 19 | 20 | * Demonstrating empathy and kindness toward other people 21 | * Being respectful of differing opinions, viewpoints, and experiences 22 | * Giving and gracefully accepting constructive feedback 23 | * Accepting responsibility and apologizing to those affected by our mistakes, 24 | and learning from the experience 25 | * Focusing on what is best not just for us as individuals, but for the overall 26 | community 27 | 28 | Examples of unacceptable behavior include: 29 | 30 | * The use of sexualized language or imagery, and sexual attention or advances of 31 | any kind 32 | * Trolling, insulting or derogatory comments, and personal or political attacks 33 | * Public or private harassment 34 | * Publishing others' private information, such as a physical or email address, 35 | without their explicit permission 36 | * Other conduct which could reasonably be considered inappropriate in a 37 | professional setting 38 | 39 | ## Enforcement Responsibilities 40 | 41 | Community leaders are responsible for clarifying and enforcing our standards of 42 | acceptable behavior and will take appropriate and fair corrective action in 43 | response to any behavior that they deem inappropriate, threatening, offensive, 44 | or harmful. 45 | 46 | Community leaders have the right and responsibility to remove, edit, or reject 47 | comments, commits, code, wiki edits, issues, and other contributions that are 48 | not aligned to this Code of Conduct, and will communicate reasons for moderation 49 | decisions when appropriate. 50 | 51 | ## Scope 52 | 53 | This Code of Conduct applies within all community spaces, and also applies when 54 | an individual is officially representing the community in public spaces. 55 | Examples of representing our community include using an official e-mail address, 56 | posting via an official social media account, or acting as an appointed 57 | representative at an online or offline event. 58 | 59 | ## Enforcement 60 | 61 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 62 | reported to the community leaders responsible for enforcement at codeofconduct@posit.co. 63 | All complaints will be reviewed and investigated promptly and fairly. 64 | 65 | All community leaders are obligated to respect the privacy and security of the 66 | reporter of any incident. 67 | 68 | ## Enforcement Guidelines 69 | 70 | Community leaders will follow these Community Impact Guidelines in determining 71 | the consequences for any action they deem in violation of this Code of Conduct: 72 | 73 | ### 1. Correction 74 | 75 | **Community Impact**: Use of inappropriate language or other behavior deemed 76 | unprofessional or unwelcome in the community. 77 | 78 | **Consequence**: A private, written warning from community leaders, providing 79 | clarity around the nature of the violation and an explanation of why the 80 | behavior was inappropriate. A public apology may be requested. 81 | 82 | ### 2. Warning 83 | 84 | **Community Impact**: A violation through a single incident or series of 85 | actions. 86 | 87 | **Consequence**: A warning with consequences for continued behavior. No 88 | interaction with the people involved, including unsolicited interaction with 89 | those enforcing the Code of Conduct, for a specified period of time. This 90 | includes avoiding interactions in community spaces as well as external channels 91 | like social media. Violating these terms may lead to a temporary or permanent 92 | ban. 93 | 94 | ### 3. Temporary Ban 95 | 96 | **Community Impact**: A serious violation of community standards, including 97 | sustained inappropriate behavior. 98 | 99 | **Consequence**: A temporary ban from any sort of interaction or public 100 | communication with the community for a specified period of time. No public or 101 | private interaction with the people involved, including unsolicited interaction 102 | with those enforcing the Code of Conduct, is allowed during this period. 103 | Violating these terms may lead to a permanent ban. 104 | 105 | ### 4. Permanent Ban 106 | 107 | **Community Impact**: Demonstrating a pattern of violation of community 108 | standards, including sustained inappropriate behavior, harassment of an 109 | individual, or aggression toward or disparagement of classes of individuals. 110 | 111 | **Consequence**: A permanent ban from any sort of public interaction within the 112 | community. 113 | 114 | ## Attribution 115 | 116 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], 117 | version 2.1, available at 118 | . 119 | 120 | Community Impact Guidelines were inspired by 121 | [Mozilla's code of conduct enforcement ladder][https://github.com/mozilla/inclusion]. 122 | 123 | For answers to common questions about this code of conduct, see the FAQ at 124 | . Translations are available at . 125 | 126 | [homepage]: https://www.contributor-covenant.org 127 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | # 4 | # NOTE: This workflow is overkill for most R packages and 5 | # check-standard.yaml is likely a better choice. 6 | # usethis::use_github_action("check-standard") will install it. 7 | on: 8 | push: 9 | branches: [main, master] 10 | pull_request: 11 | 12 | name: R-CMD-check.yaml 13 | 14 | permissions: read-all 15 | 16 | jobs: 17 | R-CMD-check: 18 | runs-on: ${{ matrix.config.os }} 19 | 20 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 21 | 22 | strategy: 23 | fail-fast: false 24 | matrix: 25 | config: 26 | - {os: macos-latest, r: 'release'} 27 | 28 | - {os: windows-latest, r: 'devel'} 29 | - {os: windows-latest, r: 'release'} 30 | # use 4.0 or 4.1 to check with rtools40's older compiler 31 | # - {os: windows-latest, r: 'oldrel-4'} 32 | 33 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 34 | - {os: ubuntu-latest, r: 'release'} 35 | - {os: ubuntu-latest, r: 'oldrel-1'} 36 | - {os: ubuntu-latest, r: 'oldrel-2'} 37 | - {os: ubuntu-latest, r: 'oldrel-3'} 38 | - {os: ubuntu-latest, r: 'oldrel-4'} 39 | 40 | env: 41 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 42 | R_KEEP_PKG_SOURCE: yes 43 | 44 | steps: 45 | - uses: actions/checkout@v4 46 | 47 | - uses: r-lib/actions/setup-pandoc@v2 48 | 49 | - uses: r-lib/actions/setup-r@v2 50 | with: 51 | r-version: ${{ matrix.config.r }} 52 | http-user-agent: ${{ matrix.config.http-user-agent }} 53 | use-public-rspm: true 54 | 55 | - uses: r-lib/actions/setup-r-dependencies@v2 56 | with: 57 | extra-packages: any::rcmdcheck 58 | needs: check 59 | 60 | - name: Install command line ping on Linux 61 | if: runner.os == 'Linux' 62 | run: | 63 | sudo apt-get install -y iputils-ping 64 | 65 | - uses: r-lib/actions/check-r-package@v2 66 | with: 67 | upload-snapshots: true 68 | build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' 69 | -------------------------------------------------------------------------------- /.github/workflows/dragonflybsd.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: [main, master] 4 | pull_request: 5 | workflow_dispatch: 6 | inputs: 7 | release: 8 | description: 'DragonFlyBSD release' 9 | required: true 10 | type: choice 11 | options: 12 | - '6.4.0' 13 | default: '6.4.0' 14 | 15 | name: dragonflybsd.yaml 16 | 17 | jobs: 18 | dragonflybsd: 19 | runs-on: ubuntu-latest 20 | steps: 21 | - uses: actions/checkout@v4 22 | - uses: r-hub/actions/setup-r-dragonflybsd@main 23 | with: 24 | release: ${{ github.event.inputs.release || '6.4.0' }} 25 | - uses: r-hub/actions/platform-info@v1 26 | 27 | - uses: r-lib/actions/setup-r-dependencies@v2 28 | with: 29 | pak-version: none 30 | install-pandoc: false 31 | install-quarto: false 32 | extra-packages: | 33 | any::rcmdcheck 34 | jeroen/openssl 35 | sodium=?ignore 36 | needs: check 37 | 38 | - uses: r-lib/actions/check-r-package@v2 39 | with: 40 | build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' 41 | upload-snapshots: true 42 | -------------------------------------------------------------------------------- /.github/workflows/freebsd.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: [main, master] 4 | pull_request: 5 | workflow_dispatch: 6 | inputs: 7 | release: 8 | description: 'FreeBSD release' 9 | required: true 10 | type: choice 11 | options: 12 | - '14.1' 13 | - '14.0' 14 | - '13.4' 15 | - '13.3' 16 | - '13.2' 17 | - '12.4' 18 | default: '14.1' 19 | 20 | name: freebsd.yaml 21 | 22 | jobs: 23 | freebsd: 24 | runs-on: ubuntu-latest 25 | steps: 26 | - uses: actions/checkout@v4 27 | - uses: r-hub/actions/setup-r-freebsd@main 28 | with: 29 | release: ${{ github.event.inputs.release || '14.1' }} 30 | - uses: r-hub/actions/platform-info@v1 31 | 32 | - uses: r-lib/actions/setup-r-dependencies@v2 33 | with: 34 | pak-version: none 35 | install-pandoc: false 36 | install-quarto: false 37 | extra-packages: any::rcmdcheck 38 | needs: check 39 | 40 | - uses: r-lib/actions/check-r-package@v2 41 | with: 42 | build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' 43 | upload-snapshots: true 44 | -------------------------------------------------------------------------------- /.github/workflows/musl.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | # 4 | # NOTE: This workflow is overkill for most R packages and 5 | # check-standard.yaml is likely a better choice. 6 | # usethis::use_github_action("check-standard") will install it. 7 | on: 8 | push: 9 | branches: [main, master] 10 | pull_request: 11 | branches: [main, master] 12 | workflow_dispatch: 13 | 14 | name: musl.yaml 15 | 16 | permissions: read-all 17 | 18 | jobs: 19 | R-CMD-check: 20 | name: Alpine 3.19 21 | runs-on: ubuntu-latest 22 | container: 23 | image: ghcr.io/r-hub/r-minimal/r-minimal:latest 24 | env: 25 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 26 | R_KEEP_PKG_SOURCE: yes 27 | 28 | steps: 29 | - uses: actions/checkout@v4 30 | 31 | - name: Install compilers, system libs 32 | run: | 33 | apk add gcc musl-dev g++ curl-dev linux-headers checkbashisms 34 | shell: bash 35 | 36 | - uses: r-lib/actions/setup-r-dependencies@v2 37 | with: 38 | extra-packages: any::rcmdcheck 39 | needs: check 40 | install-pandoc: false 41 | install-quarto: false 42 | 43 | - uses: r-lib/actions/check-r-package@v2 44 | with: 45 | upload-snapshots: true 46 | build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' 47 | env: 48 | _R_SHLIB_STRIP_: false 49 | -------------------------------------------------------------------------------- /.github/workflows/netbsd.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: [main, master] 4 | pull_request: 5 | workflow_dispatch: 6 | inputs: 7 | release: 8 | description: 'NetBSD release' 9 | required: true 10 | type: choice 11 | options: 12 | - '10.0' 13 | default: '10.0' 14 | 15 | name: netbsd.yaml 16 | 17 | jobs: 18 | netbsd: 19 | runs-on: ubuntu-latest 20 | steps: 21 | - uses: actions/checkout@v4 22 | - uses: r-hub/actions/setup-r-netbsd@main 23 | with: 24 | release: ${{ github.event.inputs.release || '10.0' }} 25 | - uses: r-hub/actions/platform-info@v1 26 | 27 | - uses: r-lib/actions/setup-r-dependencies@v2 28 | with: 29 | pak-version: none 30 | install-pandoc: false 31 | install-quarto: false 32 | extra-packages: any::rcmdcheck 33 | needs: check 34 | 35 | - uses: r-lib/actions/check-r-package@v2 36 | with: 37 | build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' 38 | upload-snapshots: true 39 | -------------------------------------------------------------------------------- /.github/workflows/openbsd.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: [main, master] 4 | pull_request: 5 | workflow_dispatch: 6 | inputs: 7 | release: 8 | description: 'OpenBSD release' 9 | required: true 10 | type: choice 11 | options: 12 | - '7.6' 13 | - '7.5' 14 | - '7.4' 15 | default: '7.6' 16 | 17 | name: openbsd.yaml 18 | 19 | jobs: 20 | openbsd: 21 | runs-on: ubuntu-latest 22 | steps: 23 | - uses: actions/checkout@v4 24 | - uses: r-hub/actions/setup-r-openbsd@v1 25 | with: 26 | release: ${{ github.event.inputs.release || '7.6' }} 27 | - uses: r-hub/actions/platform-info@v1 28 | 29 | - name: Install system packages 30 | run: | 31 | pkg_add -I libbind 32 | cd /usr/local/lib && ln -s libbind/libbind.so* . 33 | shell: openbsd {0} 34 | 35 | - uses: r-lib/actions/setup-r-dependencies@v2 36 | with: 37 | pak-version: none 38 | install-pandoc: false 39 | install-quarto: false 40 | extra-packages: any::rcmdcheck 41 | needs: check 42 | 43 | - uses: r-lib/actions/check-r-package@v2 44 | with: 45 | upload-snapshots: true 46 | build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' 47 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | release: 8 | types: [published] 9 | workflow_dispatch: 10 | 11 | name: pkgdown.yaml 12 | 13 | permissions: read-all 14 | 15 | jobs: 16 | pkgdown: 17 | runs-on: ubuntu-latest 18 | # Only restrict concurrency for non-PR jobs 19 | concurrency: 20 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 21 | env: 22 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 23 | permissions: 24 | contents: write 25 | steps: 26 | - uses: actions/checkout@v4 27 | 28 | - uses: r-lib/actions/setup-pandoc@v2 29 | 30 | - uses: r-lib/actions/setup-r@v2 31 | with: 32 | use-public-rspm: true 33 | 34 | - uses: r-lib/actions/setup-r-dependencies@v2 35 | with: 36 | extra-packages: any::pkgdown, local::. 37 | needs: website 38 | 39 | - name: Build site 40 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 41 | shell: Rscript {0} 42 | 43 | - name: Deploy to GitHub pages 🚀 44 | if: github.event_name != 'pull_request' 45 | uses: JamesIves/github-pages-deploy-action@v4.5.0 46 | with: 47 | clean: false 48 | branch: gh-pages 49 | folder: docs 50 | -------------------------------------------------------------------------------- /.github/workflows/pr-commands.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | issue_comment: 5 | types: [created] 6 | 7 | name: pr-commands.yaml 8 | 9 | permissions: read-all 10 | 11 | jobs: 12 | document: 13 | if: ${{ github.event.issue.pull_request && (github.event.comment.author_association == 'MEMBER' || github.event.comment.author_association == 'OWNER') && startsWith(github.event.comment.body, '/document') }} 14 | name: document 15 | runs-on: ubuntu-latest 16 | env: 17 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 18 | permissions: 19 | contents: write 20 | steps: 21 | - uses: actions/checkout@v4 22 | 23 | - uses: r-lib/actions/pr-fetch@v2 24 | with: 25 | repo-token: ${{ secrets.GITHUB_TOKEN }} 26 | 27 | - uses: r-lib/actions/setup-r@v2 28 | with: 29 | use-public-rspm: true 30 | 31 | - uses: r-lib/actions/setup-r-dependencies@v2 32 | with: 33 | extra-packages: any::roxygen2 34 | needs: pr-document 35 | 36 | - name: Document 37 | run: roxygen2::roxygenise() 38 | shell: Rscript {0} 39 | 40 | - name: commit 41 | run: | 42 | git config --local user.name "$GITHUB_ACTOR" 43 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 44 | git add man/\* NAMESPACE 45 | git commit -m 'Document' 46 | 47 | - uses: r-lib/actions/pr-push@v2 48 | with: 49 | repo-token: ${{ secrets.GITHUB_TOKEN }} 50 | 51 | style: 52 | if: ${{ github.event.issue.pull_request && (github.event.comment.author_association == 'MEMBER' || github.event.comment.author_association == 'OWNER') && startsWith(github.event.comment.body, '/style') }} 53 | name: style 54 | runs-on: ubuntu-latest 55 | env: 56 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 57 | permissions: 58 | contents: write 59 | steps: 60 | - uses: actions/checkout@v4 61 | 62 | - uses: r-lib/actions/pr-fetch@v2 63 | with: 64 | repo-token: ${{ secrets.GITHUB_TOKEN }} 65 | 66 | - uses: r-lib/actions/setup-r@v2 67 | 68 | - name: Install dependencies 69 | run: install.packages("styler") 70 | shell: Rscript {0} 71 | 72 | - name: Style 73 | run: styler::style_pkg() 74 | shell: Rscript {0} 75 | 76 | - name: commit 77 | run: | 78 | git config --local user.name "$GITHUB_ACTOR" 79 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 80 | git add \*.R 81 | git commit -m 'Style' 82 | 83 | - uses: r-lib/actions/pr-push@v2 84 | with: 85 | repo-token: ${{ secrets.GITHUB_TOKEN }} 86 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | 8 | name: test-coverage.yaml 9 | 10 | permissions: read-all 11 | 12 | jobs: 13 | test-coverage: 14 | runs-on: ubuntu-latest 15 | env: 16 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 17 | 18 | steps: 19 | - uses: actions/checkout@v4 20 | 21 | - uses: r-lib/actions/setup-r@v2 22 | with: 23 | use-public-rspm: true 24 | 25 | - uses: r-lib/actions/setup-r-dependencies@v2 26 | with: 27 | extra-packages: any::covr, any::xml2 28 | needs: coverage 29 | 30 | - name: Test coverage 31 | run: | 32 | cov <- covr::package_coverage( 33 | quiet = FALSE, 34 | clean = FALSE, 35 | install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") 36 | ) 37 | print(cov) 38 | covr::to_cobertura(cov) 39 | shell: Rscript {0} 40 | 41 | - uses: codecov/codecov-action@v5 42 | with: 43 | # Fail if error if not on PR, or if on PR and token is given 44 | fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} 45 | files: ./cobertura.xml 46 | plugins: noop 47 | disable_search: true 48 | token: ${{ secrets.CODECOV_TOKEN }} 49 | 50 | - name: Show testthat output 51 | if: always() 52 | run: | 53 | ## -------------------------------------------------------------------- 54 | find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true 55 | shell: bash 56 | 57 | - name: Upload test results 58 | if: failure() 59 | uses: actions/upload-artifact@v4 60 | with: 61 | name: coverage-test-failures 62 | path: ${{ runner.temp }}/package 63 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /tags 2 | /src/pingr.so 3 | /src/*.o 4 | /r-packages 5 | /revdep 6 | .Rproj.user 7 | docs 8 | /src/Makevars 9 | -------------------------------------------------------------------------------- /.vscode/extensions.json: -------------------------------------------------------------------------------- 1 | { 2 | "recommendations": [ 3 | "Posit.air-vscode" 4 | ] 5 | } 6 | -------------------------------------------------------------------------------- /.vscode/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "[r]": { 3 | "editor.formatOnSave": true, 4 | "editor.defaultFormatter": "Posit.air-vscode" 5 | } 6 | } 7 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: pingr 2 | Title: Check if a Remote Computer is Up 3 | Version: 2.0.5.9000 4 | Authors@R: c( 5 | person("Gábor", "Csárdi", , "csardi.gabor@gmail.com", role = c("aut", "cre")), 6 | person("Posit Software, PBC", role = c("cph", "fnd"), 7 | comment = c(ROR = "03wc8by49")) 8 | ) 9 | Description: Check if a remote computer is up. It can either just call the 10 | system ping command, or check a specified TCP port. 11 | License: MIT + file LICENSE 12 | URL: https://r-lib.github.io/pingr/, https://github.com/r-lib/pingr 13 | BugReports: https://github.com/r-lib/pingr/issues 14 | Depends: 15 | R (>= 3.6) 16 | Imports: 17 | processx, 18 | ps, 19 | utils 20 | Suggests: 21 | covr, 22 | testthat (>= 3.0.0) 23 | Remotes: 24 | r-lib/ps 25 | Biarch: true 26 | Config/Needs/website: tidyverse/tidytemplate 27 | Config/testthat/edition: 3 28 | Config/usethis/last-upkeep: 2025-04-30 29 | Encoding: UTF-8 30 | Roxygen: list(markdown = TRUE) 31 | RoxygenNote: 7.2.3 32 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2025 2 | COPYRIGHT HOLDER: pingr authors 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2025 pingr authors 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(apple_captive_test) 4 | export(is_online) 5 | export(is_up) 6 | export(my_ip) 7 | export(nsl) 8 | export(ping) 9 | export(ping_port) 10 | importFrom(processx,run) 11 | useDynLib(pingr, .registration = TRUE) 12 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # pingr (development version) 2 | 3 | # pingr 2.0.5 4 | 5 | * pingr now compiles with musl, e.g. on Alpine Linux, again. 6 | 7 | # pingr 2.0.4 8 | 9 | * `ping()` now handles sub-millisecond response times (#24). 10 | 11 | * `ping()` now works on FreeBSD, OpenBSD, NetBSD and DragonFlyBSD. 12 | 13 | # pingr 2.0.3 14 | 15 | * `ping_port()` now correctly prints the port if `version = TRUE`. 16 | 17 | # pingr 2.0.2 18 | 19 | * `pingr::ping()` now works better in a non-English locale (#18). 20 | 21 | # pingr 2.0.1 22 | 23 | * `is_online()` now tries the Apple captive test first, because it works better 24 | when DNS is not masked, but HTTP is (#13). 25 | 26 | * `ping()` now works on Linux systems with a non-English locale 27 | [@pekkarr](https://github.com/pekkarr) (#18). 28 | 29 | # pingr 2.0.0 30 | 31 | * New `nsl()` function to perform DNS queries. 32 | 33 | * New `my_ip()` function to query the computer's public IP address. 34 | 35 | * New `apple_captive_test()` function to check Apple's captive test 36 | web page to see if the computer is online. 37 | 38 | * Better `is_online()` implementation, it uses DNS and HTTPS instead 39 | of an ICMP ping via an external ping program. 40 | 41 | * Now `ip_up()` checks first if the computer is connected to the 42 | internet, via `is_online()`. 43 | 44 | # pingr 1.2.0 45 | 46 | * New `is_up()` function to check if a web (other other TCP) server is up. 47 | 48 | * Timeout now works correctly on Linux systems (#7). 49 | 50 | * `ping()` uses processx now to run the external ping program, so the 51 | the ping error messages do not litter the R console (#8, #9). 52 | 53 | # pingr 1.1.2 54 | 55 | No user visible changes. 56 | 57 | # pingr 1.1.0 58 | 59 | * New `is_online()` function to check if the computer is online, by 60 | pinging two DNS servers. 61 | 62 | * TCP Timeout now works for the connect phase as well. 63 | 64 | # pingr 1.0.0 65 | 66 | First release on CRAN. 67 | -------------------------------------------------------------------------------- /R/dns.R: -------------------------------------------------------------------------------- 1 | #' DNS query 2 | #' 3 | #' Perform a DNS query for a domain. It supports custom name servers, 4 | #' and querying DNS records of certain class and type. 5 | #' 6 | #' @param domain Domain to query. 7 | #' @param server Custom name server IP address, to use. Note that this 8 | #' must be an IP address currently. E.g. 8.8.8.8 is Google's DNS server. 9 | #' @param type Record type to query, an integer scalar. 1L is an A record, 10 | #' 28L is an AAAA record, etc. See e.g. 11 | #' https://en.wikipedia.org/wiki/List_of_DNS_record_types for the record 12 | #' types. 13 | #' @param class Query class. This is usually 1L, i.e. "Internet". See e.g. 14 | #' https://www.iana.org/assignments/dns-parameters/dns-parameters.xhtml#dns-parameters-2 15 | #' for all DNS classes. 16 | #' @return A list of two entries currently, additional entries might be 17 | #' added later: 18 | #' * `answer`: a data frame of DNS records, with columns: 19 | #' `name`, `class`, `type`, `ttl`, `data`. `data` is a list column and 20 | #' contains the IP(6) address for A and AAAA records, but it contains 21 | #' other data, e.g. host name for CNAME, for other records. If pingr 22 | #' could not parse a record (it only parses the most common records 23 | #' types: A, AAAA, NA, PTR, CNAME, TXT, MX, SOA), then the data of 24 | #' the record is included as a raw vector. 25 | #' * `flags`: a named logical vector of flags `aa`, `tc`, `rd`, `ra`, 26 | #' `ad`, `cd`. See the RFC (https://www.ietf.org/rfc/rfc1035.txt) for 27 | #' these. On Windows they are all set to NA currently. 28 | #' 29 | #' @export 30 | #' @examplesIf pingr:::safe_examples() 31 | #' nsl("r-project.org") 32 | #' nsl("google.com", type = 28L) 33 | 34 | nsl <- function(domain, server = NULL, type = 1L, class = 1L) { 35 | stopifnot( 36 | is_string(domain), 37 | is_string_or_null(server), 38 | is_type(type), 39 | is_class(class) 40 | ) 41 | .Call(r_nsl, domain, server, class, type) 42 | } 43 | -------------------------------------------------------------------------------- /R/http.R: -------------------------------------------------------------------------------- 1 | http_get <- function(url) { 2 | tmp <- tempfile() 3 | on.exit(unlink(tmp, recursive = TRUE), add = TRUE) 4 | 5 | suppressWarnings(utils::download.file(url, tmp, quiet = TRUE)) 6 | 7 | if (!file.exists(tmp)) stop("Cannot download `", url, "`") 8 | 9 | readChar(tmp, file.info(tmp)$size, useBytes = TRUE) 10 | } 11 | 12 | #' Download Apple's captive portal test 13 | #' 14 | #' If the test page, returns "Success" that means that the computer is 15 | #' connected to the Internet. 16 | #' 17 | #' Note that this function will fail if the computer is offline. Use 18 | #' [is_online()] to check if the computer is online. 19 | #' 20 | #' @export 21 | #' @examplesIf pingr:::safe_examples() 22 | #' apple_captive_test() 23 | 24 | apple_captive_test <- function() { 25 | out <- http_get("http://captive.apple.com/hotspot-detect.html") 26 | grepl("Success", out) 27 | } 28 | -------------------------------------------------------------------------------- /R/my-ip.R: -------------------------------------------------------------------------------- 1 | #' Query the computer's public IP address 2 | #' 3 | #' It can use a DNS query to opendns.com, if `method == "dns"`, or 4 | #' an HTTPS query to icanhazip.com, see https://github.com/major/icanhaz. 5 | #' The DNS query is much faster, the HTTPS query is secure. 6 | #' 7 | #' @param method Whether to use a DNS or HTTPS query. 8 | #' @return Computer's public IP address as a string. 9 | #' 10 | #' @export 11 | #' @examplesIf pingr:::safe_examples() 12 | #' my_ip() 13 | #' my_ip(method = "https") 14 | 15 | my_ip <- function(method = c("dns", "https")) { 16 | method <- match.arg(method) 17 | if (method == "dns") my_ip_dns() else my_ip_https() 18 | } 19 | 20 | my_ip_dns <- function() { 21 | out <- nsl("myip.opendns.com", server = "208.67.222.222", type = 1L) 22 | if ( 23 | nrow(out$answer) != 1 || 24 | out$answer$type != 1L || 25 | !is_ip_address(out$answer$data[[1]]) 26 | ) { 27 | stop("Cannot query my iP address via DNS") 28 | } 29 | 30 | out$answer$data[[1]] 31 | } 32 | 33 | is_ip_address <- function(x) { 34 | grepl("^[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+$", x) 35 | } 36 | 37 | my_ip_https <- function() { 38 | out <- http_get("https://ipv4.icanhazip.com/") 39 | out <- gsub("\\s+", "", out) 40 | 41 | if (!is_ip_address(out)) stop("Cannot query my IP address via https") 42 | 43 | out 44 | } 45 | -------------------------------------------------------------------------------- /R/ping-package.R: -------------------------------------------------------------------------------- 1 | #' Check if the local or remote computer is up 2 | #' 3 | #' @useDynLib pingr, .registration = TRUE 4 | "_PACKAGE" 5 | 6 | #' Check if a port of a server is active, measure response time 7 | #' 8 | #' @param destination Host name or IP address. 9 | #' @param port Port. 10 | #' @param continuous Logical, whether to keep pinging until 11 | #' the user interrupts. 12 | #' @param verbose Whether to print progress on the screen while 13 | #' pinging. 14 | #' @param count Number of pings to perform. 15 | #' @param timeout Timeout, in seconds. How long to wait for a 16 | #' ping to succeed. 17 | #' @return Vector of response times, in milliseconds. 18 | #' \code{NA} means no response within the timeout. 19 | #' 20 | #' @export 21 | #' @examplesIf pingr:::safe_examples() 22 | #' ping_port("r-project.org") 23 | 24 | ping_port <- function( 25 | destination, 26 | port = 80L, 27 | continuous = FALSE, 28 | verbose = continuous, 29 | count = 3L, 30 | timeout = 1.0 31 | ) { 32 | type <- "tcp" 33 | type <- switch(type, "tcp" = 0L, "udp" = 1L) 34 | timeout <- as.integer(timeout * 1000000) 35 | res <- .Call( 36 | r_ping, 37 | destination, 38 | port, 39 | type, 40 | continuous, 41 | verbose, 42 | count, 43 | timeout 44 | ) 45 | res[res == -1] <- NA_real_ 46 | res 47 | } 48 | 49 | #' Ping a remote server, to see if it is alive 50 | #' 51 | #' This is the classic ping, using ICMP packages. Only the 52 | #' system administrator can send ICMP packages, so we call out 53 | #' to the system's ping utility. 54 | #' 55 | #' @param destination Host name or IP address. 56 | #' @param continuous Logical, whether to keep pinging until the 57 | #' user interrupts. 58 | #' @param verbose Whether to print progress on the screen while 59 | #' pinging. 60 | #' @param count Number of pings to perform. 61 | #' @param timeout Timeout for a ping response. 62 | #' @return Vector of response times. \code{NA} means no response, in 63 | #' milliseconds. Currently \code{NA}s are always at the end of the vector, 64 | #' and not in their correct position. 65 | #' 66 | #' @export 67 | #' @importFrom processx run 68 | #' @examplesIf pingr:::safe_examples() 69 | #' ping("8.8.8.8") 70 | #' ping("r-project.org") 71 | 72 | ping <- function( 73 | destination, 74 | continuous = FALSE, 75 | verbose = continuous, 76 | count = 3L, 77 | timeout = 1.0 78 | ) { 79 | if (!continuous && verbose) { 80 | stop("'!continuous' && 'verbose' does not work currently") 81 | } 82 | 83 | os <- ping_os(destination, continuous, count, timeout) 84 | 85 | status <- run(os$cmd[1], os$cmd[-1], error_on_status = FALSE, env = os$env) 86 | output <- strsplit(status$stdout, "\r?\n")[[1]] 87 | 88 | if (!continuous) { 89 | timings <- grep(os$regex, output, value = TRUE, perl = TRUE) 90 | times <- sub(os$regex, "\\2", timings, perl = TRUE) 91 | res <- as.numeric(times) 92 | length(res) <- count 93 | res 94 | } else { 95 | invisible() 96 | } 97 | } 98 | 99 | ping_os <- function(destination, continuous, count, timeout) { 100 | env <- NULL 101 | 102 | if (.Platform$OS.type == "windows") { 103 | ping_file <- file.path("C:", "windows", "system32", "ping.exe") 104 | if (!file.exists(ping_file)) { 105 | ping_file <- "ping" 106 | } 107 | cmd <- c( 108 | ping_file, 109 | "-w", 110 | int(timeout * 1000), 111 | if (continuous) "-t" else c("-n", count), 112 | destination 113 | ) 114 | } else if (Sys.info()["sysname"] == "Darwin") { 115 | cmd <- c( 116 | "/sbin/ping", 117 | "-W", 118 | int(timeout * 1000), 119 | if (!continuous) c("-c", count), 120 | destination 121 | ) 122 | } else if (Sys.info()[["sysname"]] == "Linux") { 123 | cmd <- c( 124 | "ping", 125 | "-W", 126 | int(timeout), 127 | if (!continuous) c("-c", count), 128 | destination 129 | ) 130 | env <- c("current", LC_ALL = "C") 131 | } else if (Sys.info()[["sysname"]] == "SunOS") { 132 | if (timeout != 1.0) { 133 | warning("Ping `timeout` is not supported on Solaris") 134 | } 135 | cmd <- c( 136 | "/usr/sbin/ping", 137 | "-s", 138 | destination, 139 | if (!continuous) c("56", count) 140 | ) 141 | } else if (Sys.info()[["sysname"]] == "OpenBSD") { 142 | cmd <- c( 143 | "ping", 144 | "-w", 145 | int(timeout), 146 | if (!continuous) c("-c", count), 147 | destination 148 | ) 149 | } else if (Sys.info()[["sysname"]] == "NetBSD") { 150 | cmd <- c( 151 | "ping", 152 | # on NetBSD -w is a total timeout, so adjust it 153 | "-w", 154 | if (continuous) int(timeout) else count * int(timeout), 155 | if (!continuous) c("-c", count), 156 | destination 157 | ) 158 | } else if (.Platform$OS.type == "unix") { 159 | cmd <- c( 160 | "ping", 161 | "-W", 162 | int(timeout * 1000), 163 | if (!continuous) c("-c", count), 164 | destination 165 | ) 166 | } 167 | 168 | list(cmd = cmd, env = env, regex = "^.*time(=|<)(.+)[ ]?ms.*$") 169 | } 170 | 171 | #' Is the computer online? 172 | #' 173 | #' Check if the computer is online. It does three tries: 174 | #' * Retrieve Apple's Captive Portal test page, see [apple_captive_test()]. 175 | #' * Queries myip.opendns.com on OpenDNS, see [my_ip()]. 176 | #' * Retrieves icanhazip.com via HTTPS, see [my_ip()]. 177 | #' If any of these are successful, it returns `TRUE`. 178 | #' 179 | #' @param timeout Timeout for the queries. (Note: it is currently not 180 | #' used for the DNS query.) 181 | #' @return Possible values: \itemize{ 182 | #' \item \code{TRUE} Yes, online. 183 | #' \item \code{FALSE} No, not online. 184 | #' } 185 | #' 186 | #' @export 187 | #' @examplesIf pingr:::safe_examples() 188 | #' is_online() 189 | 190 | is_online <- function(timeout = 1) { 191 | opts <- options(timeout = timeout) 192 | on.exit(options(opts), add = TRUE) 193 | 194 | tryCatch( 195 | { 196 | if (apple_captive_test()) return(TRUE) 197 | }, 198 | error = function(e) NULL 199 | ) 200 | 201 | tryCatch( 202 | { 203 | my_ip(method = "dns") 204 | return(TRUE) 205 | }, 206 | error = function(e) NULL 207 | ) 208 | 209 | tryCatch( 210 | { 211 | my_ip(method = "https") 212 | return(TRUE) 213 | }, 214 | error = function(e) NULL 215 | ) 216 | 217 | FALSE 218 | } 219 | 220 | #' `is_up()` checks if a web server is up. 221 | #' 222 | #' @rdname ping_port 223 | #' @param fail_on_dns_error If `TRUE` then `is_up()` fails if the DNS 224 | #' resolution fails. Otherwise it will return `FALSE`. 225 | #' @param check_online Whether to check first if the computer is online. 226 | #' Otherwise it is possible that the computer is behind a proxy, that 227 | #' hijacks the HTTP connection to `destination`. 228 | #' @export 229 | #' @examplesIf pingr:::safe_examples() 230 | #' is_up("google.com") 231 | #' is_up("google.com", timeout = 0.01) 232 | 233 | is_up <- function( 234 | destination, 235 | port = 80, 236 | timeout = 0.5, 237 | fail_on_dns_error = FALSE, 238 | check_online = TRUE 239 | ) { 240 | if (check_online && !is_online(timeout)) return(FALSE) 241 | 242 | tryCatch( 243 | !is.na(ping_port(destination, port = port, timeout = timeout, count = 1)), 244 | error = function(e) { 245 | if (fail_on_dns_error) stop(e) 246 | FALSE 247 | } 248 | ) 249 | } 250 | -------------------------------------------------------------------------------- /R/pingr-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | "_PACKAGE" 3 | 4 | ## usethis namespace: start 5 | ## usethis namespace: end 6 | NULL 7 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | int <- as.integer 2 | 3 | is_string <- function(x) { 4 | is.character(x) && length(x) == 1 && !is.na(x) 5 | } 6 | 7 | is_string_or_null <- function(x) { 8 | is.null(x) || is_string(x) 9 | } 10 | 11 | is_count <- function(x) { 12 | is.integer(x) && length(x) == 1 && !is.na(x) 13 | } 14 | 15 | is_type <- function(x) { 16 | is_count(x) 17 | } 18 | 19 | is_class <- function(x) { 20 | is_count(x) 21 | } 22 | 23 | safe_examples <- function() { 24 | !is_cran_check() && is_online() 25 | } 26 | 27 | is_cran_check <- function() { 28 | if (identical(Sys.getenv("NOT_CRAN"), "true")) { 29 | FALSE 30 | } else { 31 | Sys.getenv("_R_CHECK_PACKAGE_NAME_", "") != "" 32 | } 33 | } 34 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | ```{r} 5 | #| label: setup 6 | #| echo: false 7 | #| message: false 8 | knitr::opts_chunk$set( 9 | comment = "#>", 10 | tidy = FALSE, 11 | error = FALSE, 12 | fig.width = 8, 13 | fig.height = 8) 14 | ``` 15 | 16 | 17 | [![R-CMD-check](https://github.com/r-lib/pingr/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/r-lib/pingr/actions/workflows/R-CMD-check.yaml) 18 | [![CRAN RStudio mirror downloads](http://cranlogs.r-pkg.org/badges/pingr)](https://r-pkg.org/pkg/pingr) 19 | [![Codecov test coverage](https://codecov.io/gh/r-lib/pingr/graph/badge.svg)](https://app.codecov.io/gh/r-lib/pingr) 20 | 21 | 22 | # pingr: check if a server is alive 23 | 24 | The pingr package has tools to check if a remote computer or web server is 25 | up and some other related tools. 26 | 27 | ## Installation 28 | 29 | Install the package from CRAN: 30 | 31 | ```r 32 | install.packages("pingr") 33 | ``` 34 | 35 | If you need the development version, install it from GitHub: 36 | 37 | ```r 38 | pak::pak("r-lib/pingr") 39 | ``` 40 | 41 | ## ICMP ping 42 | 43 | The `ping()` function does ICMP ping, via the system's `ping` utility: 44 | 45 | ```{r} 46 | library(pingr) 47 | ping("127.0.0.1") 48 | ``` 49 | 50 | By default it sends three packets and measures the time it receives and answer. 51 | It waits between sending out the packets, so if you want a really quick check, 52 | you can just send a single packet: 53 | 54 | ```{r} 55 | ping("127.0.0.1", count = 1) 56 | ``` 57 | 58 | If a machine is down (or it does not exist), then `NA` is returned instead 59 | of the roundtrip time: 60 | 61 | ```{r} 62 | ping("192.0.2.1", count = 1) 63 | ``` 64 | 65 | ## TCP ping 66 | 67 | With TCP ping we can check if a machine is listeing on a TCP port, e.g. if 68 | google's search web server is up and running: 69 | 70 | ```{r} 71 | ping_port("www.google.com", port = 80, count = 1) 72 | ``` 73 | 74 | ## Query the public IP address of the computer 75 | 76 | `my_ip()` queries the public IP of the computer, either via DNS or HTTPS: 77 | 78 | ```{r} 79 | my_ip() 80 | ``` 81 | 82 | ## Check if the computer is online 83 | 84 | `is_online()` checks if the computer is online. It makes three tries: 85 | 86 | * Queries myip.opendns.com on OpenDNS, see `my_ip()`. 87 | * Retrieves icanhazip.com via HTTPS, see `my_ip()`. 88 | * Retrieve Apple's Captive Portal test page, see `apple_captive_test()`. 89 | 90 | If any of these are successful, it returns `TRUE`. 91 | 92 | ```{r} 93 | is_online() 94 | ``` 95 | 96 | ## DNS queries 97 | 98 | The package also contains a function to perform DNS queries. This is a 99 | more portable and more functional version of the `utils::nsl()` function: 100 | 101 | ```{r} 102 | nsl("www.r-project.org", type = 1L) 103 | nsl("google.com", type = 28L) 104 | ``` 105 | 106 | ## License 107 | 108 | MIT © RStudio 109 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | [![R-CMD-check](https://github.com/r-lib/pingr/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/r-lib/pingr/actions/workflows/R-CMD-check.yaml) 5 | [![CRAN RStudio mirror 6 | downloads](http://cranlogs.r-pkg.org/badges/pingr)](https://r-pkg.org/pkg/pingr) 7 | [![Codecov test 8 | coverage](https://codecov.io/gh/r-lib/pingr/graph/badge.svg)](https://app.codecov.io/gh/r-lib/pingr) 9 | 10 | 11 | # pingr: check if a server is alive 12 | 13 | The pingr package has tools to check if a remote computer or web server 14 | is up and some other related tools. 15 | 16 | ## Installation 17 | 18 | Install the package from CRAN: 19 | 20 | ``` r 21 | install.packages("pingr") 22 | ``` 23 | 24 | If you need the development version, install it from GitHub: 25 | 26 | ``` r 27 | pak::pak("r-lib/pingr") 28 | ``` 29 | 30 | ## ICMP ping 31 | 32 | The `ping()` function does ICMP ping, via the system’s `ping` utility: 33 | 34 | ``` r 35 | library(pingr) 36 | ``` 37 | 38 | #> 39 | #> Attaching package: 'pingr' 40 | 41 | #> The following object is masked from 'package:utils': 42 | #> 43 | #> nsl 44 | 45 | ``` r 46 | ping("127.0.0.1") 47 | ``` 48 | 49 | #> [1] 0.084 0.097 0.068 50 | 51 | By default it sends three packets and measures the time it receives and 52 | answer. It waits between sending out the packets, so if you want a 53 | really quick check, you can just send a single packet: 54 | 55 | ``` r 56 | ping("127.0.0.1", count = 1) 57 | ``` 58 | 59 | #> [1] 0.069 60 | 61 | If a machine is down (or it does not exist), then `NA` is returned 62 | instead of the roundtrip time: 63 | 64 | ``` r 65 | ping("192.0.2.1", count = 1) 66 | ``` 67 | 68 | #> [1] NA 69 | 70 | ## TCP ping 71 | 72 | With TCP ping we can check if a machine is listeing on a TCP port, 73 | e.g. if google’s search web server is up and running: 74 | 75 | ``` r 76 | ping_port("www.google.com", port = 80, count = 1) 77 | ``` 78 | 79 | #> [1] 17.737 80 | 81 | ## Query the public IP address of the computer 82 | 83 | `my_ip()` queries the public IP of the computer, either via DNS or 84 | HTTPS: 85 | 86 | ``` r 87 | my_ip() 88 | ``` 89 | 90 | #> [1] "83.50.74.244" 91 | 92 | ## Check if the computer is online 93 | 94 | `is_online()` checks if the computer is online. It makes three tries: 95 | 96 | - Queries myip.opendns.com on OpenDNS, see `my_ip()`. 97 | - Retrieves icanhazip.com via HTTPS, see `my_ip()`. 98 | - Retrieve Apple’s Captive Portal test page, see `apple_captive_test()`. 99 | 100 | If any of these are successful, it returns `TRUE`. 101 | 102 | ``` r 103 | is_online() 104 | ``` 105 | 106 | #> [1] TRUE 107 | 108 | ## DNS queries 109 | 110 | The package also contains a function to perform DNS queries. This is a 111 | more portable and more functional version of the `utils::nsl()` 112 | function: 113 | 114 | ``` r 115 | nsl("www.r-project.org", type = 1L) 116 | ``` 117 | 118 | #> $answer 119 | #> name class type ttl data 120 | #> 1 www.r-project.org 1 5 7054 cran.wu-wien.ac.at 121 | #> 2 cran.wu-wien.ac.at 1 1 231 137.208.57.37 122 | #> 123 | #> $flags 124 | #> aa tc rd ra ad cd 125 | #> FALSE FALSE TRUE TRUE FALSE FALSE 126 | 127 | ``` r 128 | nsl("google.com", type = 28L) 129 | ``` 130 | 131 | #> $answer 132 | #> name class type ttl data 133 | #> 1 google.com 1 28 236 2a00:1450:4003:80d::200e 134 | #> 135 | #> $flags 136 | #> aa tc rd ra ad cd 137 | #> FALSE FALSE TRUE TRUE FALSE FALSE 138 | 139 | ## License 140 | 141 | MIT © RStudio 142 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: http://r-lib.github.io/pingr/ 2 | template: 3 | bootstrap: 5 4 | 5 | includes: 6 | in_header: | 7 | 8 | 9 | development: 10 | mode: auto 11 | -------------------------------------------------------------------------------- /air.toml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-lib/pingr/614a12bce3bbbb1bfa55d3aa2987b7e0cc8655e4/air.toml -------------------------------------------------------------------------------- /cleanup: -------------------------------------------------------------------------------- 1 | #' !/usr/bin/env sh 2 | 3 | rm -f src/Makevars 4 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | informational: true 10 | patch: 11 | default: 12 | target: auto 13 | threshold: 1% 14 | informational: true 15 | -------------------------------------------------------------------------------- /configure: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env sh 2 | 3 | # Check that this is not just ./configure. We need to run this 4 | # from R CMD INSTALL, to have the R env vars set. 5 | 6 | if [ -z "$R_HOME" ]; then 7 | echo >&2 R_HOME is not set, are you running R CMD INSTALL? 8 | exit 1 9 | fi 10 | 11 | # Find the R binary we need to use. This is a bit trickier on 12 | # Windows, because it has two architectures. On windows R_ARCH_BIN 13 | # is set, so this should work everywhere. 14 | RBIN="${R_HOME}/bin${R_ARCH_BIN}/R" 15 | 16 | # ------------------------------------------------------------------------ 17 | # Detect system 18 | # ------------------------------------------------------------------------ 19 | 20 | unset POSIX 21 | if [ "$R_OSTYPE" = "unix" ]; then 22 | UNAME=`uname` 23 | else 24 | UNAME=Windows 25 | fi 26 | 27 | if [ -n "$EMSCRIPTEN" ] && [ -n "$CROSS_COMPILE" ]; then 28 | UNAME=Emscripten 29 | fi 30 | 31 | unset WINDOWS 32 | if [ "$R_OSTYPE" = "windows" ]; then WINDOWS=true; fi 33 | 34 | unset LINUX 35 | if [ "$UNAME" = "Linux" ]; then LINUX=true; POSIX=true; fi 36 | 37 | unset MACOS 38 | if [ "$UNAME" = "Darwin" ]; then MACOS=true; POSIX=true; fi 39 | 40 | unset FREEBSD 41 | if [ "$UNAME" = "FreeBSD" ]; then FREEBSD=true; POSIX=true; fi 42 | 43 | unset OPENBSD 44 | if [ "$UNAME" = "OpenBSD" ]; then OPENBSD=true; POSIX=true; fi 45 | 46 | unset NETBSD 47 | ## if [ "$UNAME" = "NetBSD" ]; then NETBSD=true; POSIX=true; fi 48 | 49 | unset DRAGONFLY 50 | if [ "$UNAME" = "DragonFly" ]; then DRAGONFLY=true; POSIX=true; fi 51 | 52 | unset BSD 53 | if [ -n "$FREEBSD" ] || [ -n "$OPENBSD" ] || [ -n "$NETBSD" ] || [ -n "$DRAGONFLY" ]; then 54 | BSD=true 55 | fi 56 | 57 | unset SUNOS 58 | ## if [ "UNAME" = "SunOS" ]; then SUNOS=true; POSIX=true; fi 59 | 60 | unset AIX 61 | ## if [ "UNAME" = "AIX" ]; then AIX=true; POSIX=true; fi 62 | 63 | # ------------------------------------------------------------------------ 64 | # Set source files, macros, libs, compile flags 65 | # ------------------------------------------------------------------------ 66 | 67 | CPPFLAGS= 68 | 69 | if [ -n "$WINDOWS" ]; then 70 | LIBRARIES= 71 | 72 | elif [ -n "$FREEBSD" ]; then 73 | LIBRARIES= 74 | 75 | elif [ -n "$DRAGONFLY" ]; then 76 | LIBRARIES= 77 | 78 | elif [ -n "$OPENBSD" ]; then 79 | LIBRARIES=bind 80 | LIBDIRS=-L/usr/local/lib/libbind 81 | CPPFLAGS=-I/usr/local/include/bind 82 | 83 | else 84 | LIBRARIES=resolv 85 | fi 86 | 87 | # ------------------------------------------------------------------------ 88 | # Create Makevars file 89 | # ------------------------------------------------------------------------ 90 | 91 | # OBJECTS (= source files) 92 | # LIBRARIES -> PKG_LIBS 93 | 94 | LIBS=`for l in $LIBRARIES; do echo "-l${l}"; done | tr "\n", " "` 95 | LIBS="$LIBDIRS ${LIBS} $FRAMEWORKS" 96 | 97 | cat src/Makevars.in | \ 98 | sed "s|@OBJECTS@|${OBJECTS}|" | \ 99 | sed "s|@LIBS@|${LIBS}|" | \ 100 | sed "s|@TARGETS@|${TARGETS}|" | \ 101 | sed "s|@CPPFLAGS@|${CPPFLAGS}|" | \ 102 | sed "s|@EXTRA@|${EXTRA}|" > src/Makevars 103 | -------------------------------------------------------------------------------- /configure.win: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env sh 2 | 3 | sh ./configure 4 | -------------------------------------------------------------------------------- /man/apple_captive_test.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/http.R 3 | \name{apple_captive_test} 4 | \alias{apple_captive_test} 5 | \title{Download Apple's captive portal test} 6 | \usage{ 7 | apple_captive_test() 8 | } 9 | \description{ 10 | If the test page, returns "Success" that means that the computer is 11 | connected to the Internet. 12 | } 13 | \details{ 14 | Note that this function will fail if the computer is offline. Use 15 | \code{\link[=is_online]{is_online()}} to check if the computer is online. 16 | } 17 | \examples{ 18 | \dontshow{if (pingr:::safe_examples()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 19 | apple_captive_test() 20 | \dontshow{\}) # examplesIf} 21 | } 22 | -------------------------------------------------------------------------------- /man/is_online.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ping-package.R 3 | \name{is_online} 4 | \alias{is_online} 5 | \title{Is the computer online?} 6 | \usage{ 7 | is_online(timeout = 1) 8 | } 9 | \arguments{ 10 | \item{timeout}{Timeout for the queries. (Note: it is currently not 11 | used for the DNS query.)} 12 | } 13 | \value{ 14 | Possible values: \itemize{ 15 | \item \code{TRUE} Yes, online. 16 | \item \code{FALSE} No, not online. 17 | } 18 | } 19 | \description{ 20 | Check if the computer is online. It does three tries: 21 | \itemize{ 22 | \item Retrieve Apple's Captive Portal test page, see \code{\link[=apple_captive_test]{apple_captive_test()}}. 23 | \item Queries myip.opendns.com on OpenDNS, see \code{\link[=my_ip]{my_ip()}}. 24 | \item Retrieves icanhazip.com via HTTPS, see \code{\link[=my_ip]{my_ip()}}. 25 | If any of these are successful, it returns \code{TRUE}. 26 | } 27 | } 28 | \examples{ 29 | \dontshow{if (pingr:::safe_examples()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 30 | is_online() 31 | \dontshow{\}) # examplesIf} 32 | } 33 | -------------------------------------------------------------------------------- /man/my_ip.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/my-ip.R 3 | \name{my_ip} 4 | \alias{my_ip} 5 | \title{Query the computer's public IP address} 6 | \usage{ 7 | my_ip(method = c("dns", "https")) 8 | } 9 | \arguments{ 10 | \item{method}{Whether to use a DNS or HTTPS query.} 11 | } 12 | \value{ 13 | Computer's public IP address as a string. 14 | } 15 | \description{ 16 | It can use a DNS query to opendns.com, if \code{method == "dns"}, or 17 | an HTTPS query to icanhazip.com, see https://github.com/major/icanhaz. 18 | The DNS query is much faster, the HTTPS query is secure. 19 | } 20 | \examples{ 21 | \dontshow{if (pingr:::safe_examples()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 22 | my_ip() 23 | my_ip(method = "https") 24 | \dontshow{\}) # examplesIf} 25 | } 26 | -------------------------------------------------------------------------------- /man/nsl.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dns.R 3 | \name{nsl} 4 | \alias{nsl} 5 | \title{DNS query} 6 | \usage{ 7 | nsl(domain, server = NULL, type = 1L, class = 1L) 8 | } 9 | \arguments{ 10 | \item{domain}{Domain to query.} 11 | 12 | \item{server}{Custom name server IP address, to use. Note that this 13 | must be an IP address currently. E.g. 8.8.8.8 is Google's DNS server.} 14 | 15 | \item{type}{Record type to query, an integer scalar. 1L is an A record, 16 | 28L is an AAAA record, etc. See e.g. 17 | https://en.wikipedia.org/wiki/List_of_DNS_record_types for the record 18 | types.} 19 | 20 | \item{class}{Query class. This is usually 1L, i.e. "Internet". See e.g. 21 | https://www.iana.org/assignments/dns-parameters/dns-parameters.xhtml#dns-parameters-2 22 | for all DNS classes.} 23 | } 24 | \value{ 25 | A list of two entries currently, additional entries might be 26 | added later: 27 | \itemize{ 28 | \item \code{answer}: a data frame of DNS records, with columns: 29 | \code{name}, \code{class}, \code{type}, \code{ttl}, \code{data}. \code{data} is a list column and 30 | contains the IP(6) address for A and AAAA records, but it contains 31 | other data, e.g. host name for CNAME, for other records. If pingr 32 | could not parse a record (it only parses the most common records 33 | types: A, AAAA, NA, PTR, CNAME, TXT, MX, SOA), then the data of 34 | the record is included as a raw vector. 35 | \item \code{flags}: a named logical vector of flags \code{aa}, \code{tc}, \code{rd}, \code{ra}, 36 | \code{ad}, \code{cd}. See the RFC (https://www.ietf.org/rfc/rfc1035.txt) for 37 | these. On Windows they are all set to NA currently. 38 | } 39 | } 40 | \description{ 41 | Perform a DNS query for a domain. It supports custom name servers, 42 | and querying DNS records of certain class and type. 43 | } 44 | \examples{ 45 | \dontshow{if (pingr:::safe_examples()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 46 | nsl("r-project.org") 47 | nsl("google.com", type = 28L) 48 | \dontshow{\}) # examplesIf} 49 | } 50 | -------------------------------------------------------------------------------- /man/ping.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ping-package.R 3 | \name{ping} 4 | \alias{ping} 5 | \title{Ping a remote server, to see if it is alive} 6 | \usage{ 7 | ping( 8 | destination, 9 | continuous = FALSE, 10 | verbose = continuous, 11 | count = 3L, 12 | timeout = 1 13 | ) 14 | } 15 | \arguments{ 16 | \item{destination}{Host name or IP address.} 17 | 18 | \item{continuous}{Logical, whether to keep pinging until the 19 | user interrupts.} 20 | 21 | \item{verbose}{Whether to print progress on the screen while 22 | pinging.} 23 | 24 | \item{count}{Number of pings to perform.} 25 | 26 | \item{timeout}{Timeout for a ping response.} 27 | } 28 | \value{ 29 | Vector of response times. \code{NA} means no response, in 30 | milliseconds. Currently \code{NA}s are always at the end of the vector, 31 | and not in their correct position. 32 | } 33 | \description{ 34 | This is the classic ping, using ICMP packages. Only the 35 | system administrator can send ICMP packages, so we call out 36 | to the system's ping utility. 37 | } 38 | \examples{ 39 | \dontshow{if (pingr:::safe_examples()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 40 | ping("8.8.8.8") 41 | ping("r-project.org") 42 | \dontshow{\}) # examplesIf} 43 | } 44 | -------------------------------------------------------------------------------- /man/ping_port.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ping-package.R 3 | \name{ping_port} 4 | \alias{ping_port} 5 | \alias{is_up} 6 | \title{Check if a port of a server is active, measure response time} 7 | \usage{ 8 | ping_port( 9 | destination, 10 | port = 80L, 11 | continuous = FALSE, 12 | verbose = continuous, 13 | count = 3L, 14 | timeout = 1 15 | ) 16 | 17 | is_up( 18 | destination, 19 | port = 80, 20 | timeout = 0.5, 21 | fail_on_dns_error = FALSE, 22 | check_online = TRUE 23 | ) 24 | } 25 | \arguments{ 26 | \item{destination}{Host name or IP address.} 27 | 28 | \item{port}{Port.} 29 | 30 | \item{continuous}{Logical, whether to keep pinging until 31 | the user interrupts.} 32 | 33 | \item{verbose}{Whether to print progress on the screen while 34 | pinging.} 35 | 36 | \item{count}{Number of pings to perform.} 37 | 38 | \item{timeout}{Timeout, in seconds. How long to wait for a 39 | ping to succeed.} 40 | 41 | \item{fail_on_dns_error}{If \code{TRUE} then \code{is_up()} fails if the DNS 42 | resolution fails. Otherwise it will return \code{FALSE}.} 43 | 44 | \item{check_online}{Whether to check first if the computer is online. 45 | Otherwise it is possible that the computer is behind a proxy, that 46 | hijacks the HTTP connection to \code{destination}.} 47 | } 48 | \value{ 49 | Vector of response times, in milliseconds. 50 | \code{NA} means no response within the timeout. 51 | } 52 | \description{ 53 | Check if a port of a server is active, measure response time 54 | 55 | \code{is_up()} checks if a web server is up. 56 | } 57 | \examples{ 58 | \dontshow{if (pingr:::safe_examples()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 59 | ping_port("r-project.org") 60 | \dontshow{\}) # examplesIf} 61 | \dontshow{if (pingr:::safe_examples()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 62 | is_up("google.com") 63 | is_up("google.com", timeout = 0.01) 64 | \dontshow{\}) # examplesIf} 65 | } 66 | -------------------------------------------------------------------------------- /man/pingr-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ping-package.R, R/pingr-package.R 3 | \docType{package} 4 | \name{pingr-package} 5 | \alias{pingr} 6 | \alias{pingr-package} 7 | \title{Check if the local or remote computer is up} 8 | \description{ 9 | Check if a remote computer is up. It can either just call the system ping command, or check a specified TCP port. 10 | 11 | Check if a remote computer is up. It can either just call the system ping command, or check a specified TCP port. 12 | } 13 | \seealso{ 14 | Useful links: 15 | \itemize{ 16 | \item \url{https://r-lib.github.io/pingr/} 17 | \item \url{https://github.com/r-lib/pingr} 18 | \item Report bugs at \url{https://github.com/r-lib/pingr/issues} 19 | } 20 | 21 | 22 | Useful links: 23 | \itemize{ 24 | \item \url{https://r-lib.github.io/pingr/} 25 | \item \url{https://github.com/r-lib/pingr} 26 | \item Report bugs at \url{https://github.com/r-lib/pingr/issues} 27 | } 28 | 29 | } 30 | \author{ 31 | \strong{Maintainer}: Gábor Csárdi \email{csardi.gabor@gmail.com} 32 | 33 | Other contributors: 34 | \itemize{ 35 | \item Posit Software, PBC [copyright holder, funder] 36 | } 37 | 38 | } 39 | \keyword{internal} 40 | -------------------------------------------------------------------------------- /pingr.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: XeLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | -------------------------------------------------------------------------------- /src/Makevars.in: -------------------------------------------------------------------------------- 1 | PKG_LIBS = @LIBS@ 2 | PKG_CPPFLAGS = @CPPFLAGS@ 3 | -------------------------------------------------------------------------------- /src/Makevars.win: -------------------------------------------------------------------------------- 1 | PKG_LIBS = -lws2_32 -ldnsapi 2 | -------------------------------------------------------------------------------- /src/dns.c: -------------------------------------------------------------------------------- 1 | 2 | #ifdef _WIN32 3 | #include 4 | #include 5 | #else 6 | #include 7 | #include 8 | #include 9 | #endif 10 | 11 | #undef ERROR 12 | 13 | #include "pingr.h" 14 | #include "errors.h" 15 | 16 | #ifdef _WIN32 17 | 18 | #include 19 | #include 20 | 21 | #define AF_INET6 23 22 | #define NS_IN6ADDRSZ 16 23 | #define NS_INT16SZ 2 24 | 25 | // Copyright notice for inet_ntop4 and inet_ntop6 26 | 27 | /* 28 | * Copyright (c) 1996-1999 by Internet Software Consortium. 29 | * 30 | * Permission to use, copy, modify, and distribute this software for any 31 | * purpose with or without fee is hereby granted, provided that the above 32 | * copyright notice and this permission notice appear in all copies. 33 | * 34 | * THE SOFTWARE IS PROVIDED "AS IS" AND INTERNET SOFTWARE CONSORTIUM DISCLAIMS 35 | * ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES 36 | * OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL INTERNET SOFTWARE 37 | * CONSORTIUM BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL 38 | * DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR 39 | * PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS 40 | * ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 41 | * SOFTWARE. 42 | */ 43 | 44 | 45 | static const char *inet_ntop4 (const u_char *src, char *dst, size_t size) { 46 | static const char fmt[] = "%u.%u.%u.%u"; 47 | char tmp[sizeof "255.255.255.255"]; 48 | 49 | if (sprintf(tmp, fmt, src[0], src[1], src[2], src[3]) >= size) { 50 | R_THROW_ERROR("Cannot parse IPv4 address"); 51 | } 52 | return strcpy(dst, tmp); 53 | } 54 | 55 | static const char *inet_ntop6 (const u_char *src, char *dst, size_t size) { 56 | /* 57 | * Note that int32_t and int16_t need only be "at least" large enough 58 | * to contain a value of the specified size. On some systems, like 59 | * Crays, there is no such thing as an integer variable with 16 bits. 60 | * Keep this in mind if you think this function should have been coded 61 | * to use pointer overlays. All the world's not a VAX. 62 | */ 63 | char tmp[sizeof "ffff:ffff:ffff:ffff:ffff:ffff:255.255.255.255"], *tp; 64 | struct { int base, len; } best, cur; 65 | u_int words[NS_IN6ADDRSZ / NS_INT16SZ]; 66 | int i; 67 | 68 | /* 69 | * Preprocess: 70 | * Copy the input (bytewise) array into a wordwise array. 71 | * Find the longest run of 0x00's in src[] for :: shorthanding. 72 | */ 73 | memset(words, '\0', sizeof words); 74 | for (i = 0; i < NS_IN6ADDRSZ; i += 2) 75 | words[i / 2] = (src[i] << 8) | src[i + 1]; 76 | best.base = -1; 77 | cur.base = -1; 78 | best.len = 0; 79 | cur.len = 0; 80 | for (i = 0; i < (NS_IN6ADDRSZ / NS_INT16SZ); i++) { 81 | if (words[i] == 0) { 82 | if (cur.base == -1) 83 | cur.base = i, cur.len = 1; 84 | else 85 | cur.len++; 86 | } else { 87 | if (cur.base != -1) { 88 | if (best.base == -1 || cur.len > best.len) 89 | best = cur; 90 | cur.base = -1; 91 | } 92 | } 93 | } 94 | if (cur.base != -1) { 95 | if (best.base == -1 || cur.len > best.len) 96 | best = cur; 97 | } 98 | if (best.base != -1 && best.len < 2) 99 | best.base = -1; 100 | 101 | /* 102 | * Format the result. 103 | */ 104 | tp = tmp; 105 | for (i = 0; i < (NS_IN6ADDRSZ / NS_INT16SZ); i++) { 106 | /* Are we inside the best run of 0x00's? */ 107 | if (best.base != -1 && i >= best.base && 108 | i < (best.base + best.len)) { 109 | if (i == best.base) 110 | *tp++ = ':'; 111 | continue; 112 | } 113 | /* Are we following an initial run of 0x00s or any real hex? */ 114 | if (i != 0) 115 | *tp++ = ':'; 116 | /* Is this address an encapsulated IPv4? */ 117 | if (i == 6 && best.base == 0 && 118 | (best.len == 6 || (best.len == 5 && words[5] == 0xffff))) { 119 | if (!inet_ntop4(src+12, tp, sizeof tmp - (tp - tmp))) 120 | return (NULL); 121 | tp += strlen(tp); 122 | break; 123 | } 124 | tp += sprintf(tp, "%x", words[i]); 125 | } 126 | /* Was it a trailing run of 0x00's? */ 127 | if (best.base != -1 && (best.base + best.len) == 128 | (NS_IN6ADDRSZ / NS_INT16SZ)) 129 | *tp++ = ':'; 130 | *tp++ = '\0'; 131 | 132 | /* 133 | * Check for overflow, copy, and we're done. 134 | */ 135 | if ((socklen_t)(tp - tmp) > size) { 136 | R_THROW_ERROR("Cannot parse IPv6 address"); 137 | } 138 | return strcpy(dst, tmp); 139 | } 140 | 141 | SEXP r_nsl(SEXP hostname, SEXP server, SEXP class, SEXP type) { 142 | 143 | PDNS_RECORD response, ptr; 144 | DNS_STATUS ret; 145 | PIP4_ARRAY pSrvList = NULL; 146 | IN_ADDR ipaddr; 147 | int cnt = 0; 148 | const char *resnames[] = { "answer", "flags", "" }; 149 | const char *recnames[] = { "name", "class", "type", "ttl", "data", "" }; 150 | const char *flagnames[] = { "aa", "tc", "rd", "ra", "ad", "cd", "" }; 151 | SEXP result = PROTECT(mkNamed(VECSXP, resnames)); 152 | SEXP records = PROTECT(mkNamed(VECSXP, recnames)); 153 | SEXP row_names = PROTECT(Rf_allocVector(INTSXP, 2)); 154 | Rf_setAttrib(records, R_ClassSymbol, mkString("data.frame")); 155 | 156 | SET_VECTOR_ELT(result, 0, records); 157 | SET_VECTOR_ELT(result, 1, mkNamed(LGLSXP, flagnames)); 158 | 159 | if (!isNull(server)) { 160 | pSrvList = (PIP4_ARRAY) LocalAlloc(LPTR,sizeof(IP4_ARRAY)); 161 | if (!pSrvList) R_THROW_ERROR("DNS query failed, out of memory"); 162 | pSrvList->AddrCount = 1; 163 | pSrvList->AddrArray[0] = inet_addr(CHAR(STRING_ELT(server, 0))); 164 | } 165 | 166 | ret = DnsQuery_A( 167 | CHAR(STRING_ELT(hostname, 0)), 168 | INTEGER(type)[0], 169 | DNS_QUERY_STANDARD, 170 | pSrvList, 171 | &response, 172 | NULL 173 | ); 174 | 175 | if (ret) R_THROW_SYSTEM_ERROR_CODE(ret, "DNS query failed"); 176 | 177 | ptr = response; 178 | while (ptr) { 179 | cnt ++; 180 | ptr = ptr->pNext; 181 | } 182 | 183 | SET_VECTOR_ELT(records, 0, Rf_allocVector(STRSXP, cnt)); 184 | SET_VECTOR_ELT(records, 1, Rf_allocVector(INTSXP, cnt)); 185 | SET_VECTOR_ELT(records, 2, Rf_allocVector(INTSXP, cnt)); 186 | SET_VECTOR_ELT(records, 3, Rf_allocVector(INTSXP, cnt)); 187 | SET_VECTOR_ELT(records, 4, Rf_allocVector(VECSXP, cnt)); 188 | INTEGER(row_names)[0] = NA_INTEGER; 189 | INTEGER(row_names)[1] = -cnt; 190 | Rf_setAttrib(records, R_RowNamesSymbol, row_names); 191 | 192 | LOGICAL(VECTOR_ELT(result, 1))[0] = NA_LOGICAL; 193 | LOGICAL(VECTOR_ELT(result, 1))[1] = NA_LOGICAL; 194 | LOGICAL(VECTOR_ELT(result, 1))[2] = NA_LOGICAL; 195 | LOGICAL(VECTOR_ELT(result, 1))[3] = NA_LOGICAL; 196 | LOGICAL(VECTOR_ELT(result, 1))[4] = NA_LOGICAL; 197 | LOGICAL(VECTOR_ELT(result, 1))[5] = NA_LOGICAL; 198 | 199 | ptr = response; cnt = 0; 200 | while (ptr) { 201 | char buf[1025]; 202 | int raw = 0; 203 | SEXP rawdata; 204 | 205 | SET_STRING_ELT(VECTOR_ELT(records, 0), cnt, mkChar(ptr->pName)); 206 | INTEGER(VECTOR_ELT(records, 1))[cnt] = 1L; 207 | INTEGER(VECTOR_ELT(records, 2))[cnt] = (int) ptr->wType; 208 | INTEGER(VECTOR_ELT(records, 3))[cnt] = (int) ptr->dwTtl; 209 | 210 | switch(ptr->wType) { 211 | case DNS_TYPE_A: 212 | inet_ntop4((u_char*) &(ptr->Data.A.IpAddress), buf, sizeof buf); 213 | break; 214 | 215 | case DNS_TYPE_AAAA: 216 | inet_ntop6((u_char*) &(ptr->Data.AAAA.Ip6Address), buf, sizeof buf); 217 | break; 218 | 219 | case DNS_TYPE_NS: 220 | case DNS_TYPE_PTR: 221 | case DNS_TYPE_CNAME: 222 | snprintf(buf, sizeof buf, "%s", ptr->Data.PTR.pNameHost); 223 | break; 224 | 225 | case DNS_TYPE_TEXT: 226 | snprintf(buf, sizeof buf, "%s", ptr->Data.TXT.pStringArray[0]); 227 | break; 228 | 229 | case DNS_TYPE_MX: 230 | snprintf(buf, sizeof buf, "%s", ptr->Data.MX.pNameExchange); 231 | break; 232 | 233 | case DNS_TYPE_SOA: 234 | snprintf(buf, sizeof buf, "%s. %s. %u %u %u %u %u", 235 | ptr->Data.SOA.pNamePrimaryServer, 236 | ptr->Data.SOA.pNameAdministrator, 237 | (unsigned int) ptr->Data.SOA.dwSerialNo, 238 | (unsigned int) ptr->Data.SOA.dwRefresh, 239 | (unsigned int) ptr->Data.SOA.dwRetry, 240 | (unsigned int) ptr->Data.SOA.dwExpire, 241 | (unsigned int) ptr->Data.SOA.dwDefaultTtl); 242 | break; 243 | 244 | default: 245 | raw = 1; 246 | rawdata = PROTECT(Rf_allocVector(RAWSXP, ptr->wDataLength)); 247 | SET_VECTOR_ELT(VECTOR_ELT(records, 4), cnt, rawdata); 248 | UNPROTECT(1); 249 | memcpy(RAW(rawdata), &(ptr->Data.A), ptr->wDataLength); 250 | break; 251 | } 252 | 253 | if (!raw) SET_VECTOR_ELT(VECTOR_ELT(records, 4), cnt, mkString(buf)); 254 | 255 | cnt++; 256 | ptr = ptr->pNext; 257 | } 258 | 259 | /* TODO: these leak on error, we would need to use cleancall */ 260 | LocalFree(pSrvList); 261 | DnsRecordListFree(response, DnsFreeRecordList); 262 | 263 | UNPROTECT(3); 264 | return result; 265 | } 266 | 267 | #else 268 | 269 | #include 270 | #include 271 | #include 272 | #include 273 | #include 274 | 275 | #ifdef __sun 276 | #define u_int16_t uint16_t 277 | #define u_int32_t uint32_t 278 | static int xxns_name_uncompress(const u_char *msg, const u_char *eom, 279 | const u_char *src, char *dst, size_t dstsiz) { 280 | u_char tmp[NS_MAXCDNAME]; 281 | int n; 282 | 283 | if ((n = ns_name_unpack(msg, eom, src, tmp, sizeof tmp)) == -1) return -1; 284 | if (ns_name_ntop(tmp, dst, dstsiz) == -1) return -1; 285 | return n; 286 | } 287 | #else 288 | #define xxns_name_uncompress ns_name_uncompress 289 | #endif 290 | 291 | // See https://docstore.mik.ua/orelly/networking_2ndEd/dns/ch15_02.htm 292 | // for the documentation of the ns_* functions, because these are 293 | // otherwise undocumented. 294 | 295 | SEXP r_nsl(SEXP hostname, SEXP server, SEXP class, SEXP type) { 296 | int ret; 297 | unsigned char answer[64 * 1024]; 298 | ns_msg msg; 299 | u_int16_t i, cnt; 300 | const char *resnames[] = { "answer", "flags", "" }; 301 | const char *recnames[] = { "name", "class", "type", "ttl", "data", "" }; 302 | const char *flagnames[] = { "aa", "tc", "rd", "ra", "ad", "cd", "" }; 303 | SEXP result = PROTECT(mkNamed(VECSXP, resnames)); 304 | SEXP records = PROTECT(mkNamed(VECSXP, recnames)); 305 | SEXP row_names = PROTECT(Rf_allocVector(INTSXP, 2)); 306 | Rf_setAttrib(records, R_ClassSymbol, mkString("data.frame")); 307 | 308 | SET_VECTOR_ELT(result, 0, records); 309 | SET_VECTOR_ELT(result, 1, mkNamed(LGLSXP, flagnames)); 310 | 311 | #if (__RES >= 19991006) 312 | struct __res_state state; 313 | res_state statep = &state; 314 | memset(statep, 0, sizeof(state)); 315 | ret = res_ninit(statep); 316 | #else 317 | res_state statep = &_res; 318 | ret = res_init(); 319 | #endif 320 | if (ret) R_THROW_SYSTEM_ERROR("Failed to initialize resolver library"); 321 | 322 | if (!isNull(server)) { 323 | struct in_addr addr; 324 | ret = inet_pton(AF_INET, CHAR(STRING_ELT(server, 0)), &addr); 325 | statep->options &= ~(RES_DNSRCH | RES_DEFNAMES); 326 | statep->nscount = LENGTH(server); 327 | statep->nsaddr_list[0].sin_addr = addr; 328 | } 329 | 330 | #if (__RES >= 19991006) 331 | ret = res_nquery( 332 | statep, 333 | #else 334 | ret = res_query( 335 | #endif 336 | CHAR(STRING_ELT(hostname, 0)), 337 | INTEGER(class)[0], 338 | INTEGER(type)[0], 339 | answer, 340 | sizeof answer); 341 | if (ret == -1) { 342 | #if (__RES >= 19991006) 343 | res_nclose(statep); 344 | #endif 345 | R_THROW_SYSTEM_ERROR("DNS query failed"); 346 | } 347 | 348 | ret = ns_initparse(answer, ret, &msg); 349 | if (ret == -1) { 350 | #if (__RES >= 19991006) 351 | res_nclose(statep); 352 | #endif 353 | R_THROW_SYSTEM_ERROR("Cannot parse DNS answer"); 354 | } 355 | 356 | LOGICAL(VECTOR_ELT(result, 1))[0] = ns_msg_getflag(msg, ns_f_aa); 357 | LOGICAL(VECTOR_ELT(result, 1))[1] = ns_msg_getflag(msg, ns_f_tc); 358 | LOGICAL(VECTOR_ELT(result, 1))[2] = ns_msg_getflag(msg, ns_f_rd); 359 | LOGICAL(VECTOR_ELT(result, 1))[3] = ns_msg_getflag(msg, ns_f_ra); 360 | LOGICAL(VECTOR_ELT(result, 1))[4] = ns_msg_getflag(msg, ns_f_ad); 361 | LOGICAL(VECTOR_ELT(result, 1))[5] = ns_msg_getflag(msg, ns_f_cd); 362 | 363 | cnt = ns_msg_count(msg, ns_s_an); 364 | SET_VECTOR_ELT(records, 0, Rf_allocVector(STRSXP, cnt)); 365 | SET_VECTOR_ELT(records, 1, Rf_allocVector(INTSXP, cnt)); 366 | SET_VECTOR_ELT(records, 2, Rf_allocVector(INTSXP, cnt)); 367 | SET_VECTOR_ELT(records, 3, Rf_allocVector(INTSXP, cnt)); 368 | SET_VECTOR_ELT(records, 4, Rf_allocVector(VECSXP, cnt)); 369 | INTEGER(row_names)[0] = NA_INTEGER; 370 | INTEGER(row_names)[1] = -cnt; 371 | Rf_setAttrib(records, R_RowNamesSymbol, row_names); 372 | 373 | for (i = 0; i < cnt; i++) { 374 | ns_rr rec; 375 | u_int16_t class, type; 376 | u_int16_t mx; 377 | u_int32_t soa[5]; 378 | const u_char *data; 379 | char buf[NS_MAXDNAME]; 380 | int raw = 0; 381 | SEXP rawdata; 382 | 383 | ret = ns_parserr(&msg, ns_s_an, i, &rec); 384 | if (ret == -1) { 385 | #if (__RES >= 19991006) 386 | res_nclose(statep); 387 | #endif 388 | R_THROW_SYSTEM_ERROR("Cannot parse DNS record"); 389 | } 390 | class = ns_rr_class(rec); 391 | type = ns_rr_type(rec); 392 | data = ns_rr_rdata(rec); 393 | 394 | SET_STRING_ELT(VECTOR_ELT(records, 0), i, mkChar(ns_rr_name(rec))); 395 | INTEGER(VECTOR_ELT(records, 1))[i] = (int) class; 396 | INTEGER(VECTOR_ELT(records, 2))[i] = (int) type; 397 | INTEGER(VECTOR_ELT(records, 3))[i] = (int) ns_rr_ttl(rec); 398 | 399 | ret = 0; 400 | 401 | switch (type) { 402 | 403 | case ns_t_a: 404 | inet_ntop(AF_INET, data, buf, sizeof buf); 405 | break; 406 | 407 | case ns_t_aaaa: 408 | inet_ntop(AF_INET6, data, buf, sizeof buf); 409 | break; 410 | 411 | case ns_t_ns: 412 | case ns_t_ptr: 413 | case ns_t_cname: 414 | ret = xxns_name_uncompress(ns_msg_base(msg), ns_msg_end(msg), 415 | data, buf, sizeof buf); 416 | break; 417 | 418 | case ns_t_txt: 419 | snprintf(buf, (size_t) data[0]+1, "%s", data + 1); 420 | break; 421 | 422 | case ns_t_mx: 423 | NS_GET16(mx, data); 424 | ret = xxns_name_uncompress(ns_msg_base(msg), ns_msg_end(msg), 425 | data, buf, sizeof buf); 426 | break; 427 | 428 | case ns_t_soa: { 429 | char *buf2 = buf; 430 | size_t bufsize = sizeof buf; 431 | int len, j; 432 | ret = xxns_name_uncompress(ns_msg_base(msg), ns_msg_end(msg), 433 | data, buf, sizeof buf); 434 | if (ret < 0) { 435 | #if (__RES >= 19991006) 436 | res_nclose(statep); 437 | #endif 438 | R_THROW_SYSTEM_ERROR("Cannot parse SOA DNS record"); 439 | } 440 | 441 | data += ret; len = strlen(buf2); buf2 += len; bufsize -= len; 442 | if (bufsize > 2) { 443 | *buf2 = '.'; buf2++; bufsize--; *buf2 = ' '; buf2++; bufsize--; 444 | } 445 | 446 | ret = xxns_name_uncompress(ns_msg_base(msg), ns_msg_end(msg), 447 | data, buf2, bufsize); 448 | if (ret < 0) { 449 | #if (__RES >= 19991006) 450 | res_nclose(statep); 451 | #endif 452 | R_THROW_SYSTEM_ERROR("Cannot parse SOA DNS record"); 453 | } 454 | 455 | data += ret; len = strlen(buf2); buf2 += len; bufsize -= len; 456 | if (bufsize > 2) { 457 | *buf2 = '.'; buf2++; bufsize--; *buf2 = ' '; buf2++; bufsize--; 458 | } 459 | 460 | if (ns_msg_end(msg) - data < 5*NS_INT32SZ) { 461 | #if (__RES >= 19991006) 462 | res_nclose(statep); 463 | #endif 464 | R_THROW_ERROR("Cannot parse SOA DNS record"); 465 | } 466 | for (j = 0; j < 5; j++) NS_GET32(soa[j], data); 467 | snprintf(buf2, bufsize, "%u %u %u %u %u", 468 | soa[0], soa[1], soa[2], soa[3], soa[4]); 469 | break; } 470 | 471 | default: 472 | raw = 1; 473 | rawdata = PROTECT(Rf_allocVector(RAWSXP, ns_rr_rdlen(rec))); 474 | SET_VECTOR_ELT(VECTOR_ELT(records, 4), i, rawdata); 475 | UNPROTECT(1); 476 | memcpy(RAW(rawdata), ns_rr_rdata(rec), ns_rr_rdlen(rec)); 477 | break; 478 | } 479 | 480 | if (ret < 0) { 481 | #if (__RES >= 19991006) 482 | res_nclose(statep); 483 | #endif 484 | R_THROW_SYSTEM_ERROR("Cannot parse NS/PTR/CNAME DNS record"); 485 | } 486 | 487 | if (!raw) SET_VECTOR_ELT(VECTOR_ELT(records, 4), i, mkString(buf)); 488 | } 489 | 490 | #if (__RES >= 19991006) 491 | res_nclose(statep); 492 | #endif 493 | UNPROTECT(3); 494 | return result; 495 | } 496 | 497 | #endif 498 | -------------------------------------------------------------------------------- /src/errors.c: -------------------------------------------------------------------------------- 1 | 2 | #include "errors.h" 3 | 4 | #include 5 | 6 | #ifndef _WIN32 7 | #include 8 | #endif 9 | 10 | #define ERRORBUF_SIZE 4096 11 | static char errorbuf[ERRORBUF_SIZE]; 12 | 13 | SEXP r_throw_error(const char *func, const char *filename, int line, 14 | const char *msg, ...) { 15 | va_list args; 16 | va_start(args, msg); 17 | vsnprintf(errorbuf, ERRORBUF_SIZE, msg, args); 18 | va_end (args); 19 | error("%s @%s:%d (%s)", errorbuf, filename, line, func); 20 | return R_NilValue; 21 | } 22 | 23 | #ifdef _WIN32 24 | 25 | SEXP r_throw_system_error(const char *func, const char *filename, int line, 26 | DWORD errorcode, const char *sysmsg, 27 | const char *msg, ...) { 28 | 29 | va_list args; 30 | LPVOID lpMsgBuf; 31 | char *realsysmsg = sysmsg ? (char*) sysmsg : NULL; 32 | 33 | if (errorcode == -1) errorcode = GetLastError(); 34 | 35 | if (!realsysmsg) { 36 | FormatMessage( 37 | FORMAT_MESSAGE_ALLOCATE_BUFFER | 38 | FORMAT_MESSAGE_FROM_SYSTEM | 39 | FORMAT_MESSAGE_IGNORE_INSERTS, 40 | NULL, 41 | errorcode, 42 | MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), 43 | (LPTSTR) &lpMsgBuf, 44 | 0, NULL); 45 | 46 | realsysmsg = R_alloc(1, strlen(lpMsgBuf) + 1); 47 | strcpy(realsysmsg, lpMsgBuf); 48 | LocalFree(lpMsgBuf); 49 | } 50 | 51 | va_start(args, msg); 52 | vsnprintf(errorbuf, ERRORBUF_SIZE, msg, args); 53 | va_end(args); 54 | error("%s (system error %ld, %s) @%s:%d (%s)", errorbuf, errorcode, 55 | realsysmsg, filename, line, func); 56 | return R_NilValue; 57 | } 58 | 59 | #else 60 | 61 | SEXP r_throw_system_error(const char *func, const char *filename, int line, 62 | int errorcode, const char *sysmsg, 63 | const char *msg, ...) { 64 | va_list args; 65 | if (!sysmsg) sysmsg = strerror(errorcode); 66 | va_start(args, msg); 67 | vsnprintf(errorbuf, ERRORBUF_SIZE, msg, args); 68 | va_end(args); 69 | error("%s (system error %d, %s) @%s:%d (%s)", errorbuf, errorcode, sysmsg, 70 | filename, line, func); 71 | return R_NilValue; 72 | } 73 | 74 | #endif 75 | -------------------------------------------------------------------------------- /src/errors.h: -------------------------------------------------------------------------------- 1 | 2 | #ifndef R_THROW_ERROR_H 3 | #define R_THROW_ERROR_H 4 | 5 | #ifndef _GNU_SOURCE 6 | #define _GNU_SOURCE 1 7 | #endif 8 | 9 | #ifdef _WIN32 10 | #include 11 | #else 12 | #include 13 | #endif 14 | 15 | #include 16 | 17 | #define R_THROW_ERROR(...) \ 18 | r_throw_error(__func__, __FILE__, __LINE__, __VA_ARGS__) 19 | 20 | SEXP r_throw_error(const char *func, const char *filename, int line, 21 | const char *msg, ...); 22 | 23 | #ifdef _WIN32 24 | 25 | #define R_THROW_SYSTEM_ERROR(...) \ 26 | r_throw_system_error(__func__, __FILE__, __LINE__, (-1), NULL, __VA_ARGS__) 27 | #define R_THROW_SYSTEM_ERROR_CODE(errorcode, ...) \ 28 | r_throw_system_error(__func__, __FILE__, __LINE__, (errorcode), NULL, __VA_ARGS__) 29 | 30 | SEXP r_throw_system_error(const char *func, const char *filename, int line, 31 | DWORD errorcode, const char *sysmsg, 32 | const char *msg, ...); 33 | 34 | #else 35 | 36 | #define R_THROW_SYSTEM_ERROR(...) \ 37 | r_throw_system_error(__func__, __FILE__, __LINE__, errno, NULL, __VA_ARGS__) 38 | #define R_THROW_SYSTEM_ERROR_CODE(errorcode, ...) \ 39 | r_throw_system_error(__func__, __FILE__, __LINE__, errorcode, NULL, __VA_ARGS__) 40 | 41 | SEXP r_throw_system_error(const char *func, const char *filename, int line, 42 | int errorcode, const char *sysmsg, 43 | const char *msg, ...); 44 | #endif 45 | 46 | #endif 47 | -------------------------------------------------------------------------------- /src/init.c: -------------------------------------------------------------------------------- 1 | 2 | #include 3 | #include 4 | 5 | #include "pingr.h" 6 | 7 | static const R_CallMethodDef callMethods[] = { 8 | {"r_ping", (DL_FUNC) &r_ping, 7}, 9 | {"r_nsl", (DL_FUNC) &r_nsl, 4}, 10 | {NULL, NULL, 0} 11 | }; 12 | 13 | void R_init_pingr(DllInfo *dll) { 14 | R_registerRoutines(dll, NULL, callMethods, NULL, NULL); 15 | R_useDynamicSymbols(dll, FALSE); 16 | R_forceSymbols(dll, TRUE); 17 | } 18 | -------------------------------------------------------------------------------- /src/pingr.h: -------------------------------------------------------------------------------- 1 | 2 | #ifndef R_PINGR_H 3 | #define R_PINGR_H 4 | 5 | #include 6 | #include 7 | 8 | SEXP r_ping(SEXP p_destination, SEXP p_port, SEXP p_type, SEXP p_continuous, 9 | SEXP p_verbose, SEXP p_count, SEXP p_timeout); 10 | 11 | SEXP r_nsl(SEXP hostname, SEXP server, SEXP class, SEXP type); 12 | 13 | #endif 14 | -------------------------------------------------------------------------------- /src/rping.c: -------------------------------------------------------------------------------- 1 | 2 | #include 3 | #include 4 | #include 5 | 6 | #include "pingr.h" 7 | 8 | #ifdef WIN32 9 | 10 | # define WIN32_LEAN_AND_MEAN 11 | # include 12 | # include 13 | # define close closesocket 14 | 15 | # define WINSTARTUP() if (WSAStartup(MAKEWORD(2, 2), &wsaData) != 0) { \ 16 | error("Cannot initialize network"); \ 17 | } 18 | 19 | # define WINCLEANUP() WSACleanup() 20 | 21 | void usleep(__int64 usec) { 22 | HANDLE timer; 23 | LARGE_INTEGER ft; 24 | ft.QuadPart = -(10*usec); 25 | timer = CreateWaitableTimer(NULL, TRUE, NULL); 26 | SetWaitableTimer(timer, &ft, 0, NULL, NULL, 0); 27 | WaitForSingleObject(timer, INFINITE); 28 | CloseHandle(timer); 29 | } 30 | 31 | #else 32 | 33 | # include 34 | # include 35 | # include 36 | # include 37 | # include 38 | # include 39 | # include 40 | # define WINSTARTUP() 41 | # define WINCLEANUP() 42 | #endif 43 | 44 | #include 45 | #include 46 | #include 47 | 48 | SEXP r_ping(SEXP p_destination, SEXP p_port, SEXP p_type, SEXP p_continuous, 49 | SEXP p_verbose, SEXP p_count, SEXP p_timeout) { 50 | 51 | SEXP result; 52 | 53 | const char *destination; 54 | int port, type, continuous, verbose, count, timeout; 55 | 56 | struct in_addr ip_address; 57 | struct hostent *remote_host = NULL; 58 | int i = 0; 59 | 60 | #ifdef WIN32 61 | WSADATA wsaData; 62 | #endif 63 | 64 | /* ---------------------------------------------------------------- */ 65 | /* Check arguments */ 66 | /* ---------------------------------------------------------------- */ 67 | 68 | if (LENGTH(p_destination) != 1) { 69 | error("destination must be a character scalar"); 70 | } 71 | if (LENGTH(p_port) != 1) { error("port must be a numeric scalar"); } 72 | if (LENGTH(p_type) != 1) { error("type must be a character scalar"); } 73 | if (LENGTH(p_continuous) != 1) { 74 | error("continuous must be a logical scalar"); 75 | } 76 | if (LENGTH(p_verbose) != 1) { error("verbose must be a logical scalar"); } 77 | if (LENGTH(p_count) != 1) { error("type must be a numeric scalar"); } 78 | if (LENGTH(p_timeout) != 1) { error("type must be a numeric scalar"); } 79 | 80 | destination = CHAR(STRING_ELT(AS_CHARACTER(p_destination), 0)); 81 | port = INTEGER(AS_INTEGER(p_port))[0]; 82 | type = INTEGER(AS_INTEGER(p_type))[0]; 83 | if (type == 0) { type = IPPROTO_TCP; } else { type = IPPROTO_UDP; } 84 | continuous = INTEGER(AS_INTEGER(p_continuous))[0]; 85 | verbose = INTEGER(AS_INTEGER(p_verbose))[0]; 86 | count = INTEGER(AS_INTEGER(p_count))[0]; 87 | timeout = INTEGER(AS_INTEGER(p_timeout))[0]; 88 | 89 | /* ---------------------------------------------------------------- */ 90 | /* Resolve host */ 91 | /* ---------------------------------------------------------------- */ 92 | 93 | WINSTARTUP(); 94 | 95 | remote_host = gethostbyname(destination); 96 | if (!remote_host) { error("Cannot resolve host name"); } 97 | ip_address = *(struct in_addr*) remote_host->h_addr_list[0]; 98 | 99 | WINCLEANUP(); 100 | 101 | if (verbose) { 102 | Rprintf("TCP PING %s (%s) Port: %d.\n", destination, 103 | inet_ntoa(ip_address), port); 104 | } 105 | 106 | /* ---------------------------------------------------------------- */ 107 | /* Main ping loop */ 108 | /* ---------------------------------------------------------------- */ 109 | 110 | PROTECT(result = NEW_NUMERIC(count)); 111 | 112 | while (1) { 113 | 114 | /* Try to connect */ 115 | 116 | struct timeval tv, start, stop; 117 | double t_start, t_stop; 118 | struct sockaddr_in c_address; 119 | fd_set read, write; 120 | int c_socket, ret; 121 | double time; 122 | #ifdef WIN32 123 | u_long imode = 1; 124 | #endif 125 | 126 | WINSTARTUP(); 127 | 128 | c_socket = socket(AF_INET, 129 | type == IPPROTO_UDP ? SOCK_DGRAM : SOCK_STREAM, 130 | type); 131 | 132 | if (c_socket == -1) { 133 | WINCLEANUP(); 134 | error("Cannot connect to host"); 135 | } 136 | 137 | c_address.sin_addr = ip_address; 138 | c_address.sin_family = AF_INET; 139 | c_address.sin_port = htons(port); 140 | 141 | tv.tv_sec = timeout / 1000000; 142 | tv.tv_usec = timeout % 1000000; 143 | 144 | gettimeofday(&start, NULL); 145 | 146 | /* Set non-blocking */ 147 | #ifdef WIN32 148 | ioctlsocket(c_socket, FIONBIO, &imode); 149 | #else 150 | if (fcntl(c_socket, F_SETFL, O_NONBLOCK) < 0) { 151 | error("Cannot set socket to non-blocking"); 152 | } 153 | #endif 154 | 155 | ret = connect(c_socket, (const struct sockaddr*) &c_address, 156 | sizeof(c_address)); 157 | 158 | #ifdef WIN32 159 | ret = WSAGetLastError(); 160 | if (ret != WSAEWOULDBLOCK && ret != 0) { error("Cannot connect"); } 161 | 162 | #else 163 | if (ret < 0 && errno != EINPROGRESS) { error("Cannot connect"); } 164 | #endif 165 | 166 | FD_ZERO(&read); 167 | FD_ZERO(&write); 168 | FD_SET(c_socket, &read); 169 | FD_SET(c_socket, &write); 170 | 171 | ret = select(c_socket + 1, &read, &write, NULL, &tv); 172 | 173 | if (ret != 1) { 174 | close(c_socket); 175 | time = NA_REAL; 176 | } else { 177 | gettimeofday(&stop, NULL); 178 | t_start = start.tv_usec + start.tv_sec * 1000000; 179 | t_stop = stop.tv_usec + stop.tv_sec * 1000000; 180 | time = (t_stop - t_start) / 1000; 181 | } 182 | 183 | if (!FD_ISSET(c_socket, &read) && !FD_ISSET(c_socket, &write)) { 184 | close(c_socket); 185 | time = NA_REAL; 186 | } 187 | 188 | REAL(result)[i] = time; 189 | 190 | close(c_socket); 191 | WINCLEANUP(); 192 | 193 | if (verbose) { 194 | if (ISNA(time)) { 195 | Rprintf("Request timeout for package %i\n", i + 1); 196 | } else { 197 | Rprintf("From %s: ping=%i time=%.3f ms\n", destination, 198 | i + 1, time); 199 | } 200 | } 201 | 202 | /* Are we done? */ 203 | 204 | i++; 205 | if (!continuous && i == count) { break; } 206 | R_CheckUserInterrupt(); 207 | 208 | /* No, wait a bit then */ 209 | 210 | usleep((1000 - time) * 1000); 211 | } 212 | 213 | UNPROTECT(1); 214 | return result; 215 | } 216 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | # This file is part of the standard setup for testthat. 2 | # It is recommended that you do not modify it. 3 | # 4 | # Where should you do additional test configuration? 5 | # Learn more about the roles of various files in: 6 | # * https://r-pkgs.org/testing-design.html#sec-tests-files-overview 7 | # * https://testthat.r-lib.org/articles/special-files.html 8 | 9 | library(testthat) 10 | library(pingr) 11 | 12 | if (Sys.getenv("NOT_CRAN") != "") { 13 | test_check("pingr") 14 | } 15 | -------------------------------------------------------------------------------- /tests/testthat/test-icmp.R: -------------------------------------------------------------------------------- 1 | test_that("We can ping localhost", { 2 | # fragile on windows 3 | testthat::skip_on_os("windows") 4 | pr <- ping("127.0.0.1", count = 1) 5 | expect_true(is.double(pr)) 6 | expect_true(length(pr) == 1) 7 | expect_true(pr < 5000) 8 | }) 9 | 10 | test_that("We can ping a remote host", { 11 | ## can't ping google.com from GHA... 12 | testthat::skip_on_ci() 13 | 14 | ## Non-existent IP 15 | pr <- ping("0.0.0.1", count = 1) 16 | print(pr) 17 | expect_equal(pr, NA_real_) 18 | 19 | ## Google 20 | pr <- ping("google.com", count = 1, timeout = 5.0) 21 | expect_true(is.double(pr)) 22 | expect_true(length(pr) == 1) 23 | print(pr) 24 | expect_true(pr < 5000) 25 | 26 | pr <- ping("8.8.8.8", count = 1, timeout = 5.0) 27 | expect_true(is.double(pr)) 28 | expect_true(length(pr) == 1) 29 | print(pr) 30 | expect_true(pr < 5000) 31 | }) 32 | 33 | test_that("We don't wait too long", { 34 | ## TODO 35 | expect_true(TRUE) 36 | }) 37 | -------------------------------------------------------------------------------- /tests/testthat/test-tcp.R: -------------------------------------------------------------------------------- 1 | test_that("We can ping localhost", { 2 | ## Chances are, there is nothing here 3 | pr <- ping_port("127.0.0.1", port = 4695, count = 1) 4 | expect_equal(pr, NA_real_) 5 | 6 | if (.Platform$OS.type == "windows" && .Platform$r_arch == "i386") { 7 | skip("does not work on old i386 windows R") 8 | } 9 | 10 | ## Start web server 11 | r_httpd_port <- if (R.version[["svn rev"]] < 67550) { 12 | try(tools::startDynamicHelp(TRUE), silent = TRUE) 13 | getFromNamespace("httpdPort", "tools") 14 | } else { 15 | tools::startDynamicHelp(NA) 16 | } 17 | pr <- ping_port("127.0.0.1", port = r_httpd_port, count = 1) 18 | expect_true(is.double(pr)) 19 | expect_true(length(pr) == 1) 20 | expect_true(pr < 1000) 21 | 22 | ## Shut down web server 23 | tools::startDynamicHelp(start = FALSE) 24 | }) 25 | 26 | test_that("We can ping a remote host", { 27 | ## There is surely nothing here 28 | pr <- ping_port("igraph.org", port = 4695, count = 1) 29 | expect_equal(pr, NA_real_) 30 | 31 | ## There is surely something here 32 | pr <- ping_port("github.com", count = 1) 33 | expect_true(is.double(pr)) 34 | expect_true(length(pr) == 1) 35 | expect_true(pr < 5000) 36 | }) 37 | 38 | test_that("We don't wait too long", { 39 | ## TODO 40 | expect_true(TRUE) 41 | }) 42 | 43 | test_that("We don't wait for the resolver", { 44 | ## TODO 45 | expect_true(TRUE) 46 | }) 47 | --------------------------------------------------------------------------------