diff options
235 files changed, 8884 insertions, 1805 deletions
diff --git a/.github/dockerfiles/Dockerfile.32-bit b/.github/dockerfiles/Dockerfile.32-bit new file mode 100644 index 0000000000..5885bcf7b8 --- /dev/null +++ b/.github/dockerfiles/Dockerfile.32-bit @@ -0,0 +1,19 @@ +FROM docker.pkg.github.com/erlang/otp/i386-debian-base + +ARG MAKEFLAGS=-j4 +ENV MAKEFLAGS=$MAKEFLAGS \ + ERLC_USE_SERVER=yes \ + ERL_TOP=/buildroot/otp \ + PATH=/buildroot/otp/bin:$PATH + +ARG ARCHIVE=./otp.tar.gz +COPY $ARCHIVE /buildroot/otp.tar.gz +RUN cd /buildroot && tar -xzf ./otp.tar.gz + +WORKDIR /buildroot/otp/ + +RUN ./configure --prefix=/otp && make && make install + +RUN TESTSUITE_ROOT=/tests ./otp_build tests + +ENTRYPOINT ["bash","-c"] diff --git a/.github/dockerfiles/Dockerfile.64-bit b/.github/dockerfiles/Dockerfile.64-bit new file mode 100644 index 0000000000..c651cbc618 --- /dev/null +++ b/.github/dockerfiles/Dockerfile.64-bit @@ -0,0 +1,22 @@ +FROM docker.pkg.github.com/erlang/otp/ubuntu-base + +## We do a SSA lint check here +ENV ERL_COMPILER_OPTIONS=ssalint + +ARG MAKEFLAGS=-j4 +ENV MAKEFLAGS=$MAKEFLAGS \ + ERLC_USE_SERVER=yes \ + ERL_TOP=/buildroot/otp \ + PATH=/buildroot/otp/bin:$PATH + +ARG ARCHIVE=./otp.tar.gz +COPY $ARCHIVE /buildroot/otp.tar.gz +RUN cd /buildroot && tar -xzf ./otp.tar.gz + +WORKDIR /buildroot/otp/ + +RUN ./configure --prefix=/otp && make && make install + +RUN TESTSUITE_ROOT=/tests ./otp_build tests + +ENTRYPOINT ["bash","-c"] diff --git a/.github/dockerfiles/Dockerfile.cross-compile b/.github/dockerfiles/Dockerfile.cross-compile new file mode 100644 index 0000000000..98f7f0e576 --- /dev/null +++ b/.github/dockerfiles/Dockerfile.cross-compile @@ -0,0 +1,56 @@ +## +## This docker file will build Erlang on 32-bit to 64-bit x86 +## +FROM docker.pkg.github.com/erlang/otp/i386-debian-base as build + +ARG MAKEFLAGS=-j4 +ENV MAKEFLAGS=$MAKEFLAGS \ + ERLC_USE_SERVER=yes \ + ERL_TOP=/buildroot/otp + +ARG ARCHIVE=./otp.tar.gz +COPY $ARCHIVE /buildroot/otp.tar.gz +RUN cd /buildroot && tar xzf ./otp.tar.gz + +WORKDIR /buildroot/otp/ + +## Build the bootstrap system +RUN ./configure && make && make install + +## Build pre-build tar ball +RUN scripts/build-otp-tar -o /buildroot/otp_clean_src.tar.gz /buildroot/otp_src.tar.gz \ + -b /buildroot/otp/ /buildroot/otp.tar.gz + +## Prepare for a new build using pre-built tar ball +RUN cd .. && rm -rf otp && tar -xzf ./otp_src.tar.gz + +ENV HOST=$HOST_TRIP \ + CC=$HOST_TRIP-gcc \ + CPP=$HOST_TRIP-cpp \ + CXX=$HOST_TRIP-g++ \ + LD=$CC \ + DED_LDFLAGS="-shared -Wl,-Bsymbolic" \ + RANLIB=$HOST_TRIP-ranlib \ + AR=$HOST_TRIP-ar \ + erl_xcomp_sysroot=/buildroot/sysroot + +## Build the cross system +RUN ./configure --prefix=/otp/ --host=$HOST --build=`erts/autoconf/config.guess` && \ + make && make install + +## Build the cross tests +RUN ./otp_build tests +RUN cd release/tests/test_server && \ + erl -sname test@docker -noshell \ + -eval "ts:install([{cross,\"yes\"},{crossflags,[{\"host\",\"$HOST\"}]},{crossroot,\"/$ERL_TOP\"}])." \ + -s ts compile_testcases -s init stop + +FROM debian as install + +# Install the released application +COPY --from=build /otp /otp +COPY --from=build /buildroot/otp/release/tests /tests + +ENV PATH=/otp/bin:$PATH + +ENTRYPOINT ["bash","-c"] diff --git a/.github/dockerfiles/Dockerfile.debian-base b/.github/dockerfiles/Dockerfile.debian-base new file mode 100644 index 0000000000..416edd97c9 --- /dev/null +++ b/.github/dockerfiles/Dockerfile.debian-base @@ -0,0 +1,43 @@ +## +## This docker file will build a base image for building Erlang/OTP +## +ARG BASE=debian +FROM $BASE +## Need to have a second arg here as the first does not expose the $BASE in the script below +ARG BASE=debian + +ARG HOST_TRIP=x86_64-linux-gnu +ENV HOST_TRIP=$HOST_TRIP + +ENV INSTALL_LIBS="zlib1g-dev libncurses5-dev libssh-dev unixodbc-dev libgmp3-dev libwxbase3.0-dev libwxgtk3.0-dev libwxgtk-webview3.0-gtk3-dev libsctp-dev lksctp-tools" + +## See https://wiki.debian.org/Multiarch/HOWTO for details on how to install things +## +## 1. Install build-essential to get access to dpkg-architecture +## 2. Use dpkg-architecture to figure out what we are runnon on +## 3. If the HOST_TRIP does not equal BUILD_TRIP we should cross compile +RUN apt-get update && apt-get -y upgrade && apt-get install -y build-essential && \ + BUILD_TRIP=`dpkg-architecture -t${HOST_TRIP} -qDEB_BUILD_MULTIARCH` && \ + BUILD_ARCH=`dpkg-architecture -t${HOST_TRIP} -qDEB_BUILD_ARCH` && \ + if [ "$HOST_TRIP" != "$BUILD_TRIP" ]; then \ + HOST_ARCH=`dpkg-architecture -t${HOST_TRIP} -qDEB_HOST_ARCH` && \ + dpkg --add-architecture $HOST_ARCH && \ + sed -i "s:deb http:deb [arch=$BUILD_ARCH,$HOST_ARCH] http:g" /etc/apt/sources.list; \ + fi && \ + apt-get update && \ + apt-get install -y build-essential m4 autoconf fop xsltproc default-jdk libxml2-utils \ + $INSTALL_LIBS && \ + if [ "$HOST_TRIP" != "$BUILD_TRIP" ]; then \ + apt-get install -y \ + crossbuild-essential-$HOST_ARCH \ + $(for LIB in $INSTALL_LIBS; do echo "$LIB:$HOST_ARCH"; done) && \ + for dir in `find / -type d -name $HOST_TRIP`; do \ + echo -n "$dir: /buildroot/sysroot"; \ + echo `dirname $dir`; \ + mkdir -p /buildroot/sysroot$dir; \ + cp -r `dirname $dir`/* `dirname /buildroot/sysroot$dir`; \ + cp -r $dir/* `dirname /buildroot/sysroot$dir`; \ + done; \ + fi && \ + update-alternatives --set wx-config /usr/lib/${BUILD_TRIP}/wx/config/gtk3-unicode-3.0 && \ + rm -rf /var/lib/apt/lists/* diff --git a/.github/dockerfiles/Dockerfile.documentation b/.github/dockerfiles/Dockerfile.documentation new file mode 100644 index 0000000000..65d3910430 --- /dev/null +++ b/.github/dockerfiles/Dockerfile.documentation @@ -0,0 +1,24 @@ +FROM docker.pkg.github.com/erlang/otp/ubuntu-base + +ARG MAKEFLAGS=-j4 +ENV MAKEFLAGS=$MAKEFLAGS \ + ERLC_USE_SERVER=yes \ + ERL_TOP=/buildroot/otp \ + PATH=/buildroot/otp/bin:$PATH + +ARG ARCHIVE=./otp.tar.gz +COPY $ARCHIVE /buildroot/otp.tar.gz +RUN cd /buildroot && tar -xzf ./otp.tar.gz + +WORKDIR /buildroot/otp/ + +## We don't build pdf in order to save some time +ENV RELEASE_ROOT=/otp DOC_TARGETS="html man chunks" + +RUN ./configure --prefix=/otp && make && make release + +RUN ./configure && make && make release + +RUN make docs release_docs + +ENTRYPOINT ["bash","-c"] diff --git a/.github/dockerfiles/Dockerfile.ubuntu-base b/.github/dockerfiles/Dockerfile.ubuntu-base new file mode 100644 index 0000000000..55983f296a --- /dev/null +++ b/.github/dockerfiles/Dockerfile.ubuntu-base @@ -0,0 +1,13 @@ +## +## This docker file will build a base image for building Erlang/OTP +## +FROM ubuntu + +ENV INSTALL_LIBS="zlib1g-dev libncurses5-dev libssh-dev unixodbc-dev libgmp3-dev libwxbase3.0-dev libwxgtk3.0-gtk3-dev libsctp-dev lksctp-tools" + +ENV DEBIAN_FRONTEND=noninteractive + +RUN apt-get update && \ + apt-get -y upgrade && \ + apt-get install -y build-essential m4 autoconf fop xsltproc \ + default-jdk libxml2-utils $INSTALL_LIBS diff --git a/.github/scripts/base-tag b/.github/scripts/base-tag new file mode 100755 index 0000000000..6683793762 --- /dev/null +++ b/.github/scripts/base-tag @@ -0,0 +1,20 @@ +#!/bin/bash + +set -x + +case "$1" in + *i386-debian-base) + BASE="i386/debian" + BASE_TYPE=debian-base + ;; + *debian-base) + BASE="debian" + BASE_TYPE=debian-base + ;; + *ubuntu-base) + BASE="ubuntu" + BASE_TYPE=ubuntu-base + ;; +esac +echo "::set-output name=BASE::${BASE}" +echo "::set-output name=BASE_TYPE::${BASE_TYPE}" diff --git a/.github/workflows/main.yaml b/.github/workflows/main.yaml new file mode 100644 index 0000000000..988bf3b07e --- /dev/null +++ b/.github/workflows/main.yaml @@ -0,0 +1,217 @@ +## +## This workflow handles testing of pull requests and pushes. +## It also publishes some packages to any new Erlang/OTP release +## +## To speed this up it would be nice if one could share docker +## images inbetween different jobs, but at the moment this is +## not possible so we need to rebuild all of Erlang/OTP multiple +## times. +## +## Also once the windows runner supports WSL we should implement +## support for building Erlang/OTP here. +## +## When ghcr.io support using the GITHUB_TOKEN we should migrate +## over to use it instead as that should allow us to use the +## built-in caching mechanisms of docker/build-push-action@v2. +## However as things are now we use docker directly to make things +## work. +## + +name: Build and check Erlang/OTP + +on: + push: + pull_request: + +jobs: + + pack: + name: Pack the Erlang/OTP tar.gz + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v2 + - name: Commit autoconf files + ## We first commit the autoconf generate so that they + ## are kept in the pre-built achive + run: | + ./otp_build autoconf + find . -name aclocal.m4 | xargs git add -f + find . -name configure | xargs git add -f + find . -name config.h.in | xargs git add -f + find . -name config.guess | xargs git add -f + find . -name config.sub | xargs git add -f + find . -name install-sh | xargs git add -f + git config --global user.email "you@example.com" + git config --global user.name "Your Name" + git commit --no-verify -m 'Add generated configure files' + - name: Archive git repository + run: git archive --prefix otp/ -o otp_src.tar.gz HEAD + - name: Upload source tar archive + uses: actions/upload-artifact@v2 + with: + name: otp_git_archive + path: otp_src.tar.gz + + build: + name: Build Erlang/OTP + runs-on: ubuntu-latest + needs: pack + + strategy: + matrix: + type: [64-bit,32-bit,cross-compile,documentation] + fail-fast: false + + steps: + - uses: actions/checkout@v2 + - name: Download source archive + uses: actions/download-artifact@v2 + with: + name: otp_git_archive + - name: Docker login + uses: docker/login-action@v1 + with: + registry: docker.pkg.github.com + username: ${{ github.repository_owner }} + password: ${{ secrets.GITHUB_TOKEN }} + - name: Calculate BASE image + id: base + run: | + BASE_TAG=$(grep "^FROM" .github/dockerfiles/Dockerfile.${{ matrix.type }} | head -1 | awk '{print $2}') + echo "::set-output name=BASE_TAG::${BASE_TAG}" + .github/scripts/base-tag "${BASE_TAG}" + - name: Pull BASE image + run: docker pull ${{ steps.base.outputs.BASE_TAG }} + - name: Build BASE image + run: | + docker build --pull --tag ${{ steps.base.outputs.BASE_TAG }} \ + --cache-from ${{ steps.base.outputs.BASE_TAG }} \ + --file .github/dockerfiles/Dockerfile.${{ steps.base.outputs.BASE_TYPE }} \ + --build-arg BASE=${{ steps.base.outputs.BASE }} . + - name: Build ${{ matrix.type }} image + run: | + docker build --tag otp --file .github/dockerfiles/Dockerfile.${{ matrix.type }} \ + --build-arg ARCHIVE=otp_src.tar.gz . + + ## Smoke build tests + - if: matrix.type == '32-bit' || matrix.type == '64-bit' || matrix.type == 'cross-compile' + name: Run smoke test + run: docker run -v $PWD/scripts:/scripts otp "cd /tests && /scripts/run-smoke-tests" + + ## Documentation checks + - if: matrix.type == 'documentation' + name: Run xmllimt + run: docker run otp "make xmllint" + - if: matrix.type == 'documentation' + name: Run html link check + run: docker run -v $PWD/scripts:/scripts otp "/scripts/otp_html_check /otp doc/index.html" + - if: matrix.type == 'documentation' + name: Release docs to publish + run: | + docker run -v $PWD/:/github otp "make release_docs DOC_TARGETS='man html pdf' RELEASE_ROOT=/github/docs" + sudo chown -R `whoami` docs + cd docs + tar czf ../otp_doc_man.tar.gz man + rm -rf man + tar czf ../otp_doc_html.tar.gz * + - if: matrix.type == 'documentation' + name: Upload html documentation archive + uses: actions/upload-artifact@v2 + with: + name: otp_doc_html + path: otp_doc_html.tar.gz + - if: matrix.type == 'documentation' + name: Upload man documentation archive + uses: actions/upload-artifact@v2 + with: + name: otp_doc_man + path: otp_doc_man.tar.gz + + ## Run dialyzer + - if: matrix.type == '64-bit' + name: Run dialyzer + run: docker run -v $PWD/scripts:/scripts otp "/scripts/run-dialyzer" + + ## Build pre-built tar archives + - if: matrix.type == '32-bit' + name: Build pre-built tar archives + run: | + docker run -v $PWD:/github otp \ + "scripts/build-otp-tar -o /github/otp_clean_src.tar.gz /github/otp_src.tar.gz -b /buildroot/otp/ /buildroot/otp.tar.gz" + - if: matrix.type == '32-bit' + name: Upload pre-built tar archive + uses: actions/upload-artifact@v2 + with: + name: otp_prebuilt + path: otp_src.tar.gz + + ## If this is a tag that has been pushed we do some release work + release: + name: Release Erlang/OTP + runs-on: ubuntu-latest + needs: build + if: startsWith(github.ref, 'refs/tags/') && github.repository == 'erlang/otp' + steps: + ## This step outputs the tag name and whether the tag is a release or patch + ## (all releases have only two version identifiers, while patches have three + ## or more) + - name: Get Tag Name + id: tag + run: | + TAG=${GITHUB_REF#refs/tags/} + VSN=${TAG#OTP-} + IS_RELEASE=`$(echo $TAG | grep -E '^OTP-[0-9]+\.[0-9]+$' > /dev/null) \ + && echo "true" || echo "false"` + echo "::set-output name=tag::${TAG}" + echo "::set-output name=vsn::${VSN}" + echo "::set-output name=release::${IS_RELEASE}" + + - uses: actions/checkout@v2 + + ## Publish the pre-built archive and docs + - name: Download source archive + uses: actions/download-artifact@v2 + with: + name: otp_prebuilt + - name: Download html docs + uses: actions/download-artifact@v2 + with: + name: otp_doc_html + - name: Download man docs + uses: actions/download-artifact@v2 + with: + name: otp_doc_man + + ## We add the correct version name into the file names + ## and create the hash files for all assets + - name: Create pre-build and doc archives + run: | + mkdir artifacts + tar -xzf otp_src.tar.gz + mv otp otp_src_${{ steps.tag.outputs.vsn }} + tar -czf artifacts/otp_src_${{ steps.tag.outputs.vsn }}.tar.gz otp_src_${{ steps.tag.outputs.vsn }} + mv otp_doc_man.tar.gz artifacts/otp_doc_man_${{ steps.tag.outputs.vsn }}.tar.gz + mv otp_doc_html.tar.gz artifacts/otp_doc_html_${{ steps.tag.outputs.vsn }}.tar.gz + + - name: Build OTP Bundle + if: steps.tag.outputs.release == 'true' + run: | + scripts/bundle-otp ${{ steps.tag.outputs.tag }} + + ## Create hash files + - name: Create pre-build and doc archives + run: | + shopt -s nullglob + cd artifacts + md5sum {*.tar.gz,*.txt} > MD5.txt + sha256sum {*.tar.gz,*.txt} > SHA256.txt + + - name: Upload pre-built and doc tar archives + uses: softprops/action-gh-release@v1 + with: + name: OTP ${{ steps.tag.outputs.vsn }} + files: | + artifacts/*.tar.gz + artifacts/*.txt + env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} diff --git a/.github/workflows/update-base.yaml b/.github/workflows/update-base.yaml new file mode 100644 index 0000000000..6cf2eafac2 --- /dev/null +++ b/.github/workflows/update-base.yaml @@ -0,0 +1,41 @@ +name: Update docker base image + +## Update the base image every day +on: + schedule: + ## In UTC + - cron: '0 0 * * *' + +## Build base images to be used by other github workflows +jobs: + + build: + name: Update base Erlang/OTP build images + if: github.repository == 'erlang/otp' + runs-on: ubuntu-latest + + strategy: + matrix: + type: [debian-base,ubuntu-base,i386-debian-base] + + steps: + - uses: actions/checkout@v2 + - name: Docker login + uses: docker/login-action@v1 + with: + registry: docker.pkg.github.com + username: ${{ github.actor }} + password: ${{ secrets.GITHUB_TOKEN }} + - name: Calculate BASE image + id: base + run: | + echo "::set-output name=BASE_TAG::docker.pkg.github.com/erlang/otp/${{ matrix.type }}" + .github/scripts/base-tag "${{ matrix.type }}" + - name: Build base image + run: | + docker build --pull --tag ${{ steps.base.outputs.BASE_TAG }} \ + --cache-from ${{ steps.base.outputs.BASE_TAG }} \ + --file .github/dockerfiles/Dockerfile.${{ steps.base.outputs.BASE_TYPE }} \ + --build-arg BASE=${{ steps.base.outputs.BASE }} . + - name: Push base image + run: docker push ${{ steps.base.outputs.BASE_TAG }} diff --git a/.gitignore b/.gitignore index b90bda1763..1d12948441 100644 --- a/.gitignore +++ b/.gitignore @@ -33,6 +33,7 @@ armv7l-unknown-linux-gnueabihf i686-pc-linux-gnu x86_64-unknown-linux-gnu i386-apple-darwin[0-9]*.[0-9]*.[0-9]* +arm-apple-darwin[0-9]*.[0-9]*.[0-9]* x86_64-apple-darwin[0-9]*.[0-9]*.[0-9]* sparc-sun-solaris[0-9]*.[0-9]* i386-pc-solaris[0-9]*.[0-9]* diff --git a/.travis.yml b/.travis.yml index ee724f8947..5cdef141c0 100644 --- a/.travis.yml +++ b/.travis.yml @@ -5,6 +5,8 @@ sudo: false os: - linux +dist: xenial + addons: apt: packages: @@ -12,10 +14,8 @@ addons: - libncurses-dev - build-essential - libssl-dev - - libwxgtk2.8-dev - - libgl1-mesa-dev + - libwxgtk3.0-dev - libglu1-mesa-dev - - libpng3 - default-jdk - g++ - xsltproc @@ -23,29 +23,7 @@ addons: matrix: include: - # Dialyzer is first as it takes the longest to run - - env: Linux64Dialyzer - addons: - apt: - packages: - # Don't build with wx, java or xslt to get faster build - - autoconf - - libncurses-dev - - build-essential - - libssl-dev - script: - - ./scripts/build-otp - - ./scripts/run-dialyzer - - env: Linux32 - services: - - docker - script: - - ./scripts/build-docker-otp 32 sh -c "scripts/build-otp release && ./otp_build tests && scripts/run-smoke-tests && bin/dialyzer --build_plt --apps erts kernel stdlib" - - env: Linux64SmokeTest - script: - - ./scripts/build-otp - - ./otp_build tests - - ./scripts/run-smoke-tests + # Doc build second as it also takes a long time to run - env: Linux64Docbuild script: - ./scripts/build-otp docs @@ -54,7 +32,7 @@ matrix: repo: erlang/cd target-branch: master skip-cleanup: true - keep-history: true + keep-history: false verbose: true github-token: $ERLANG_CD_GITHUB_TOKEN on: @@ -63,27 +41,26 @@ matrix: tags: false condition: $TRAVIS_PULL_REQUEST = "false" repo: erlang/otp - # This stage publishes a otp bundle that contains multiple - # Erlang/OTP source repositories - - stage: deploy - env: Deploy - if: tag =~ ^OTP-[0-9]+\.[0-9]+$ + - env: Linux-ppc64le-SmokeTest + os: linux-ppc64le script: - - ./scripts/bundle-otp - deploy: - provider: releases - skip_cleanup: true - api_key: - secure: vW5PN6zng5H5+TCvwfwpGZsABrdCWYcFwDm3KXq+plsecBmTayu/0jgNso5Z97FbzDGVTLHWchvywEYQWnmrEByyOrqH73v1LN6JEfN99VpSrdFr15IzhblcyU1R9ugYc3WEoYjX0Q1uGelDSWRuuQOPbzy8mZf3D4rSGonyraP7jPTdHhs5P3ZWk6OMFz+tCdF4XohXqbhXIBOeH/EKg0svX2u5IcV01/YOL8LHWz6G7+gqBryEXx1+ngjQXQmMQwd7Yg3WOKE4XV9gX8ixZsbpUPZXAQKF+VOYdEgeiIr1hI0tBQUYX7FYEzYH5MCxqng5RdaPTOAm1oQroyGkIcWSXzDwN4AhJ7xqa/0NRdEaBPdQzPBCc+pVUDkxBR1ytXjBQqdQMnI6184TDiU5XBnj3kmieLkkKPKQNoPve/Y8Q8zutw4GNc7gixGcQCjtAFUbrT73QVRrezQH0qIdt23rivvf2R7CCOWSmgzowrswmtHdgeEVbodUIBPTNp7qzlUk9gDp6vW0XrOC4qEFI+VaY5PsEOXrrxZmI3gGGJgsbfzRvzvvupQcLNERniJ67r/uumbForpL0x1c65scKuMWwcn1wqt2OLbDoIIuM31Ph2HX/09TTqECU7CTvqLT5MnbZHXGjY9c3ch+sY3tSfaEX6aazl/Dqx28c7boCEw= - file: - - ${TRAVIS_TAG}-bundle.txt - - ${TRAVIS_TAG}-bundle.tar.gz - on: - # We only deploy on pushes to tags that match the regexp - tags: true - condition: $TRAVIS_TAG =~ ^OTP-[0-9]+\.[0-9]+$ - repo: erlang/otp - + - ./scripts/build-otp + - ./otp_build tests + - ./scripts/run-smoke-tests + addons: + apt: + update: true + packages: + - autoconf + - libncurses-dev + - build-essential + - libssl-dev + - libwxgtk3.0-dev + - libglu1-mesa-dev + - default-jdk + - g++ + - xsltproc + - libxml2-utils before_script: - set -e diff --git a/OTP_VERSION b/OTP_VERSION index a011a9766c..ec108169ab 100644 --- a/OTP_VERSION +++ b/OTP_VERSION @@ -1 +1 @@ -21.3.8 +21.3.8.23 diff --git a/configure.in b/configure.in index 2a42477723..c807851859 100644 --- a/configure.in +++ b/configure.in @@ -372,50 +372,6 @@ if test X${enable_native_libs} = Xyes -a X${enable_hipe} != Xno; then fi AC_SUBST(NATIVE_LIBS_ENABLED) -if test $CROSS_COMPILING = no; then - case $host_os in - darwin*) - macosx_version=`sw_vers -productVersion` - test $? -eq 0 || { - AC_MSG_ERROR([Failed to execute 'sw_vers'; please provide it in PATH]) - } - [case "$macosx_version" in - [1-9][0-9].[0-9]) - int_macosx_version=`echo $macosx_version | sed 's|\([^\.]*\)\.\([^\.]*\)|\1\2|'`;; - [1-9][0-9].[0-9].[0-9]) - int_macosx_version=`echo $macosx_version | sed 's|\([^\.]*\)\.\([^\.]*\)\.\([^\.]*\)|\1\2\3|'`;; - [1-9][0-9].[1-9][0-9]) - int_macosx_version=`echo $macosx_version | sed 's|\([^\.]*\)\.\([^\.]*\)|\1\200|'`;; - [1-9][0-9].[1-9][0-9].[0-9]) - int_macosx_version=`echo $macosx_version | sed 's|\([^\.]*\)\.\([^\.]*\)\.\([^\.]*\)|\1\20\3|'`;; - [1-9][0-9].[1-9][0-9].[1-9][0-9]) - int_macosx_version=`echo $macosx_version | sed 's|\([^\.]*\)\.\([^\.]*\)\.\([^\.]*\)|\1\2\3|'`;; - *) - int_macosx_version=unexpected;; - esac] - test $int_macosx_version != unexpected || { - AC_MSG_ERROR([Unexpected MacOSX version ($macosx_version) returned by 'sw_vers -productVersion'; this configure script probably needs to be updated]) - } - AC_TRY_COMPILE([ -#if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ > $int_macosx_version -#error Compiling for a newer MacOSX version... -#endif - ], [;], - [], - [AC_MSG_ERROR([ - - You are natively building Erlang/OTP for a later version of MacOSX - than current version ($macosx_version). You either need to - cross-build Erlang/OTP, or set the environment variable - MACOSX_DEPLOYMENT_TARGET to $macosx_version (or a lower version). - -])]) - ;; - *) - ;; - esac -fi - rm -f $ERL_TOP/lib/SKIP-APPLICATIONS for app in `cd lib && ls -d *`; do var=`eval echo \\$with_$app` @@ -426,6 +382,7 @@ done export ERL_TOP AC_CONFIG_SUBDIRS(lib erts) +ERL_DED AC_CONFIG_FILES([Makefile make/output.mk]) AC_CONFIG_FILES([make/emd2exml], [chmod +x make/emd2exml]) diff --git a/erts/aclocal.m4 b/erts/aclocal.m4 index 3d227e462c..9a1eb48a87 100644 --- a/erts/aclocal.m4 +++ b/erts/aclocal.m4 @@ -221,6 +221,7 @@ AC_TRY_COMPILE([],[ #endif __label__ lbl1; __label__ lbl2; + extern int magic(void); int x = magic(); static void *jtab[2]; @@ -266,6 +267,7 @@ if test "$ac_cv_prog_emu_cc" != no; then #endif __label__ lbl1; __label__ lbl2; + extern int magic(void); int x = magic(); static void *jtab[2]; @@ -2801,6 +2803,7 @@ AC_DEFUN([LM_HARDWARE_ARCH], [ ppc64) ARCH=ppc64;; ppc64le) ARCH=ppc64le;; "Power Macintosh") ARCH=ppc;; + arm64) ARCH=arm64;; armv5b) ARCH=arm;; armv5teb) ARCH=arm;; armv5tel) ARCH=arm;; diff --git a/erts/configure.in b/erts/configure.in index 3ba8216a19..0271f5efa1 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -733,7 +733,7 @@ dnl First remove common_tests skip file. dnl Adjust LDFLAGS to allow 64bit linkage on DARWIN case $ARCH-$OPSYS in - amd64-darwin*) + amd64-darwin*|arm64-darwin*) AC_MSG_NOTICE([Adjusting LDFLAGS to cope with 64bit Darwin]) case $LDFLAGS in *-m64*) @@ -2145,6 +2145,7 @@ AC_CACHE_CHECK( #include <sys/types.h> #include <sys/socket.h> #include <netinet/in.h> + #include <stdio.h> ]], [[printf("%d", in6addr_any.s6_addr[16]);]] )], @@ -2168,6 +2169,7 @@ AC_CACHE_CHECK( #include <sys/types.h> #include <sys/socket.h> #include <netinet/in.h> + #include <stdio.h> ]], [[printf("%d", in6addr_loopback.s6_addr[16]);]] )], diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index 133f160dc9..9a6c0a41a5 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -1016,8 +1016,8 @@ </item> <tag><marker id="+SDio"/><c><![CDATA[+SDio DirtyIOSchedulers]]></c></tag> <item> - <p>Sets the number of dirty I/O scheduler threads to create. - Valid range is 0-1024. By + <p>Sets the number of dirty I/O scheduler threads to create. + Valid range is 1-1024. By default, the number of dirty I/O scheduler threads created is 10, same as the default number of threads in the <seealso marker="#async_thread_pool_size">async thread pool</seealso>.</p> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 6932b18571..cbcf84f3d9 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -6692,10 +6692,9 @@ lists:map( anchor="statistics_run_queue" since=""/> <fsummary>Information about the run-queues.</fsummary> <desc> - <p>Returns the total length of all normal run-queues. That is, the number - of processes and ports that are ready to run on all available - normal run-queues. Dirty run queues are not part of the - result. The information is gathered atomically. That + <p>Returns the total length of all normal and dirty CPU + run queues. That is, queued work that is expected + to be CPU bound. The information is gathered atomically. That is, the result is a consistent snapshot of the state, but this operation is much more expensive compared to <seealso marker="#statistics_total_run_queue_lengths"> diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index e8a7d88f9e..4d443725dc 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -31,6 +31,687 @@ </header> <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 10.3.5.18</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>The following signals could pass before other signals + from the same sender to the same receiver. That is, these + signals could arrive too early.</p> <list> + <item><c>garbage-collect</c> request. Sent from one + process to another using one of the + <c>garbage_collect()</c> BIFs.</item> + <item><c>check-process-code</c> request. Sent from one + process to another using one of the + <c>check_process_code()</c> BIFs.</item> + <item><c>is-process-alive</c> reply. Sent as a response + to a process calling the <c>is_process_alive()</c> + BIF.</item> <item><c>process-info</c> reply. Sent as a + response to a process calling one of the + <c>process_info()</c> BIFs.</item> + <item><c>port-command</c> reply. Sent as a response to a + process calling one of the <c>port_command()</c> + BIFs.</item> <item><c>port-connect</c> reply. Sent as a + response to a process calling the <c>port_connect()</c> + BIF.</item> <item><c>port-close</c> reply. Sent as a + response to a process calling the <c>port_close()</c> + BIF.</item> <item><c>port-control</c> reply. Sent as a + response to a process calling the <c>port_control()</c> + BIF.</item> <item><c>port-call</c> reply. Sent as a + response to a process calling the <c>port_call()</c> + BIF.</item> <item><c>port-info</c> reply. Sent as a + response to a process calling one of the + <c>port_info()</c> BIFs.</item> </list> + <p> + Own Id: OTP-17291</p> + </item> + <item> + <p> + A garbage collection of a literal area missed messages + that entirely consisted of a term in a literal area. This + could in turn lead to a crash of the runtime system.</p> + <p> + Own Id: OTP-17307</p> + </item> + <item> + <p> + A call to <c>process_flag(message_queue_data, + off_heap)</c> could cause a crash of the runtime system + when sequential tracing was enabled.</p> + <p> + Own Id: OTP-17349</p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.3.5.17</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed a bug in the timer implementation which could cause + timers that were set to more than 37.25 hours in the + future to be delayed. This could occur if there were + multiple timers scheduled to be triggered very close in + time, but still at different times, and the scheduler + thread handling the timers was not able to handle them + quickly enough. Delayed timers were in this case + triggered when another unrelated timer was triggered.</p> + <p> + Own Id: OTP-17253</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fix a file descriptor leak when using sendfile and the + remote side closes the connection. This bug has been + present since OTP-21.0.</p> + <p> + Own Id: OTP-17244</p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.3.5.16</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixed a bug that could cause some work scheduled for + execution on scheduler threads to be delayed until other + similar work appeared. Beside delaying various cleanup of + internal data structures also the following could be + delayed:</p> <list> <item>Termination of a distribution + controller process</item> <item>Disabling of the + distribution on a node</item> <item>Gathering of memory + allocator information using the <c>instrument</c> + module</item> <item>Enabling, disabling, and gathering of + <c>msacc</c> information</item> <item>Delivery of + <c>'CHANGE'</c> messages when time offset is + monitored</item> <item>A call to + <c>erlang:cancel_timer()</c></item> <item>A call to + <c>erlang:read_timer()</c></item> <item>A call to + <c>erlang:statistics(io | garbage_collection | + scheduler_wall_time)</c></item> <item>A call to + <c>ets:all()</c></item> <item>A call to + <c>erlang:memory()</c></item> <item>A call to + <c>erlang:system_info({allocator | allocator_sizes, + _})</c></item> <item>A call to + <c>erlang:trace_delivered()</c></item> </list> <p>The bug + existed on runtime systems running on all types of + hardware except for x86/x86_64.</p> + <p> + Own Id: OTP-17185</p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.3.5.15</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed rare distribution bug in race between received + signal (link/monitor/spawn_request/spawn_reply) and + disconnection. Symptom: VM crash. Since: OTP 21.0.</p> + <p> + Own Id: OTP-16869 Aux Id: ERL-1337 </p> + </item> + <item> + <p> + The <c>suspend_process()</c> and <c>resume_process()</c> + BIFs did not check their arguments properly which could + cause an emulator crash.</p> + <p> + Own Id: OTP-17080</p> + </item> + <item> + <p> + The runtime system would get into an infinite loop if the + runtime system was started with more than 1023 file + descriptors already open.</p> + <p> + Own Id: OTP-17088 Aux Id: ERIERL-580 </p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.3.5.14</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The ERTS internal I/O poll implementation could get into + an inconsistent state causing input events to be ignored.</p> + <p> + Own Id: OTP-16780 Aux Id: PR-2701 </p> + </item> + <item> + <p> + The documentation of <c>statistics(run_queue)</c> + erroneously stated that it returns the total length of + all normal run queues when it is the total length of all + normal and dirty CPU run queues that is returned. The + documentation has been updated to reflect the actual + behavior.</p> + <p> + Own Id: OTP-16866 Aux Id: ERL-1355 </p> + </item> + <item> + <p> + Two bugs in the ERTS internal thread wakeup functionality + have been fixed. These bugs mainly hit when all threads + in the system tried to go to sleep. When the bugs were + triggered, certain operations were delayed until a thread + woke up due to some other reason. Most important + operations effected were code loading, persistent term + updates, and memory deallocation.</p> + <p> + Own Id: OTP-16870</p> + </item> + <item> + <p> + Fixed bug in <c>ets:select_replace/2</c> on + <c>compressed</c> tables that could produce faulty + results or VM crash. Bug exists since OTP 20.</p> + <p> + Own Id: OTP-16874 Aux Id: ERL-1356, PR-2763 </p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.3.5.13</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + An unintentional reuse of an already used emulator + internal event object could cause a wakeup signal to a + thread to be lost. In worst case this could cause the + runtime system to hang. This hang was however quite rare.</p> + <p> + Own Id: OTP-16766 Aux Id: ERL-1304 </p> + </item> + <item> + <p> + NIF threads and driver threads on non-Linux systems + leaked internal resources when terminating. On Windows + these resources were one event per thread. On most other + systems one mutex and one condition variable per thread. + On these other systems that also lacked + <c>pthread_cond_timedwait()</c> also a pipe with its file + descriptors was leaked.</p> + <p> + Own Id: OTP-16772 Aux Id: ERL-1304 </p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.3.5.12</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The functionality utilized by BIFs for temporary + disabling of garbage collection while yielding could + cause system task queues to become inconsistent on a + process executing such a BIF. Process system tasks are + for example utilized when purging code, garbage + collecting literal data, and when issuing an ordinary + garbage collection from another process.</p> + <p> + The bug does not trigger frequently. Multiple code purges + in direct sequence makes it more likely that this bug is + triggered. In the cases observed, this has resulted in a + hanging code purge operation.</p> + <p> + Own Id: OTP-16639 Aux Id: ERL-1236 </p> + </item> + <item> + <p> + A literal area could prematurely be released before all + uses of it had been removed. This occurred either when a + terminating process had a complex exit reason referring + to a literal that concurrently was removed, or when a + terminating process continued executing a dirty NIF + accessing a literal (via the heap) that concurrently was + removed.</p> + <p> + Own Id: OTP-16640 Aux Id: OTP-16193 </p> + </item> + <item> + <p> + The VM could potentially crash when checking process code + of a process that terminated while executing a dirty NIF. + The checking of process code is part of a code purge + operation.</p> + <p> + Own Id: OTP-16641</p> + </item> + <item> + <p> + System tasks of <c>low</c> priority were not interleaved + with <c>normal</c> priority system tasks as they should. + This could potentially delay garbage collection of + another process longer than intended if the garbage + collection was requested from a <c>low</c> priority + process.</p> + <p> + Own Id: OTP-16642</p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.3.5.11</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + <seealso marker="stdlib:re#run/3">re:run(Subject, RE, + [unicode])</seealso> returned <c>nomatch</c> instead of + failing with a <c>badarg</c> error exception when + <c>Subject</c> contained illegal utf8 and <c>RE</c> was + passed as a binary. This has been corrected along with + corrections of reduction counting in <c>re:run()</c> + error cases.</p> + <p> + Own Id: OTP-16553</p> + </item> + <item> + <p>Fixed a bug that could cause the emulator to crash + when purging modules or persistent terms.</p> + <p> + Own Id: OTP-16555 Aux Id: ERL-1188 </p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.3.5.10</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed bug in <c>ets:update_counter/4</c>, when called + with an invalid <c>UpdateOp</c> and a <c>Key</c> that + does not exist, causing <c>ets:info(T,size)</c> to return + incorrect values. Bug exists since OTP-19.0.2.</p> + <p> + Own Id: OTP-16404 Aux Id: ERL-1127 </p> + </item> + <item> + <p> + A process could get into an inconsistent state where it + was runnable, but never scheduled for execution. This + could occur when a mix of <c>normal</c> and <c>low</c> + priority processes where scheduled on the same type of + dirty scheduler simultaneously.</p> + <p> + Own Id: OTP-16446 Aux Id: ERL-1157 </p> + </item> + <item> + <p> + Corrected the valid range of the <c>erl</c> command line + argument <seealso marker="erts:erl#+SDio"><c>+SDio + <NumberOfDirtyIoSchedulers></c></seealso> from + <c>0..1024</c> to <c>1..1024</c>. <c>+SDio 0</c> was + erroneously allowed which just caused the VM to crash on + the first dirty I/O job scheduled.</p> + <p> + Own Id: OTP-16481</p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.3.5.9</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A process could end up in a state where it got endlessly + rescheduled without making any progress. This occurred + when a system task, such as check of process code (part + of a code purge), was scheduled on a high priority + process trying to execute on a dirty scheduler.</p> + <p> + Own Id: OTP-16436 Aux Id: ERL-1152 </p> + </item> + <item> + <p> + Fixed bug in <c>erlang:list_to_ref/1</c> when called with + a reference created by a remote note. Function + <c>list_to_ref/1</c> is intended for debugging and not to + be used in application programs. Bug exist since OTP + 20.0.</p> + <p> + Own Id: OTP-16438</p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.3.5.8</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Taking a scheduler offline could cause timers set while + executing on that scheduler to be delayed until the + scheduler was put online again. This bug was introduced + in ERTS version 10.0 (OTP 21.0).</p> + <p> + Own Id: OTP-16371</p> + </item> + <item> + <p> + A process calling <seealso + marker="erts:erlang#system_flag_multi_scheduling"><c>erlang:system_flag(multi_scheduling, + block)</c></seealso> could end up blocked waiting for the + operation to complete indefinitely.</p> + <p> + Own Id: OTP-16379</p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.3.5.7</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A literal area could prematurely be released before all + uses of it had been removed. This occurred either when a + terminating process had a complex exit reason referring + to a literal that concurrently was removed, or when a + terminating process continued executing a dirty NIF + accessing a literal (via the heap) that concurrently was + removed.</p> + <p> + Own Id: OTP-16193</p> + </item> + <item> + <p> + Fix bug causing VM crash due to memory corruption of + distribution entry. Probability of crash increases if + Erlang distribution is frequently disconnected and + reestablished towards same node names. Bug exists since + OTP-21.0.</p> + <p> + Own Id: OTP-16224 Aux Id: ERL-1044 </p> + </item> + <item> + <p> + Fix bug where the receive marker used by the runtime to + do the receive queue optimization could be incorrectly + set. The symptom of this would be that a message that + should match in a receive never matches.</p> + <p> + The bug requires the OTP-22 compiler and multiple + selective receives to trigger. See OTP-16219 for details + about the bug fix in the compiler.</p> + <p> + Own Id: OTP-16241 Aux Id: ERL-1076 OTP-16219 </p> + </item> + <item> + <p> + Fixed bug causing crash of VM built with configuration + <c>--enable--sharing-preserving</c>. Provoked when a sent + message contains both a bit string and the heap binary + (< 65 bytes) which the bit string was matched from. + Bug exists since OTP-19.0 but has seen to be easier to + provoke since OTP-22.1.</p> + <p> + Own Id: OTP-16265 Aux Id: ERL-1064 </p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.3.5.6</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix a bug in <c>binary_to_term</c> that would crash the + emulator if a term larger than 16GB was to be decoded.</p> + <p> + Own Id: OTP-16058 Aux Id: PR-2382 </p> + </item> + <item> + <p> + When communicating with a simultaneously exiting port via + the <c>erlang:port_*()</c> BIFs one could sometimes get + stray <c>{Ref, What}</c> messages. Where <c>Ref</c> was a + reference and <c>What</c> usually were the atom + <c>badarg</c>.</p> + <p> + Own Id: OTP-16107 Aux Id: ERL-1049 </p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.3.5.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p><c>process_info(P,binary)</c> would neglect to look + through heap fragments, potentially missing a few + binaries associated with the process.</p> + <p> + Own Id: OTP-15978 Aux Id: ERIERL-366 </p> + </item> + <item> + <p> + Fixed bug triggered if a process is killed during call to + <c>persistent_term:put</c> or + <c>persistent_term:erase</c>.</p> + <p> + Own Id: OTP-16041</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p>Fixed rare emulator crash in + <c>instrument:allocations/0-1</c>.</p> + <p> + Own Id: OTP-15983</p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.3.5.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed bug causing VM crash when doing textual dump of a + process containing an unhandled monitor down signal. + Textual process dumps can be done with + <c>erlang:system_info(procs)</c>, trace feature + <c>process_dump</c>, Erlang shell break menu and a + crashdump. Bug exist since OTP 21.0.</p> + <p> + Own Id: OTP-15909 Aux Id: ERL-979 </p> + </item> + <item> + <p><c>lists:subtract/2</c> would produce incorrect + results for some inputs on 64-bit platforms.</p> + <p> + Own Id: OTP-15938 Aux Id: ERL-986 </p> + </item> + <item> + <p>Fixed a bug in the loader that was similar to + <c>OTP-15938</c>, yielding incorrect code for some inputs + on 64-bit platforms.</p> + <p> + Own Id: OTP-15939</p> + </item> + <item> + <p> + Fixed bug causing scheduler threads in rare cases to + block spinnning indefinitely. Bug exists since OTP 21.0.</p> + <p> + Own Id: OTP-15941 Aux Id: PR-2313 </p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.3.5.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + If you set <c>{linger,{true,0}}</c> on a <c>gen_tcp</c> + listen socket, accept a connection on that socket, and + then close the accepted socket, now the linger zero + setting is transferred to the accepted socket. Before + this correction that information was lost and the close + behaviour on the accepted socket incorrect.</p> + <p> + Own Id: OTP-15370 Aux Id: ERIERL-353 </p> + </item> + <item> + <p> + Fixed <c>process_info(Pid,reductions)</c> to not + categorically increase reduction count of the measured + process <c>Pid</c>. Repeated reduction measure of an idle + process will most often (but not guaranteed) return the + same value, like it behaved before OTP 21.3.8.</p> + <p> + Own Id: OTP-15865 Aux Id: ERL-964 </p> + </item> + <item> + <p> + The runtime system disconnected a connection if it + received an <c>exit/2</c> signal where the recipient was + a process on an old incarnation of the current node. That + is, the receiving node had the same node name, but + another "creation" number. The signal will now just be + dropped since the receiving process no longer exists.</p> + <p> + Own Id: OTP-15867 Aux Id: ERIERL-373 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The possibility to send ancillary data, in particular the + TOS field, has been added to <c>gen_udp:send/4,5</c>.</p> + <p> + Own Id: OTP-15747 Aux Id: ERIERL-294 </p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.3.5.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>In nested use of <c>try</c>/<c>catch</c>, rethrowing + an exception using <c>erlang:raise/3</c> with a different + class would not always be able to change the class of the + exception.</p> + <p> + Own Id: OTP-15834 Aux Id: ERIERL-367 </p> + </item> + <item> + <p> + Fixed bug in <c>seq_trace:set_token(label,Term)</c> which + could cause VM crash if <c>Term</c> was heap allocated + (not an atom, small integer, local pid or port). Bug + exists since OTP 21.0 when terms other than small + integers were first allowed as labels.</p> + <p> + Own Id: OTP-15849 Aux Id: ERL-700 </p> + </item> + <item> + <p> + Fix <c>seq_trace:print/2</c> not to raise <c>badarg</c> + exception if label is not a small integer. Bug exists + since OTP 21.0.</p> + <p> + Own Id: OTP-15859 Aux Id: ERL-700 </p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.3.5.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixed a buffer overflow when + <c>binary_to_existing_atom/2</c> and + <c>list_to_existing_atom/2</c> was used with the + <c>latin1</c> encoding.</p> + <p> + Own Id: OTP-15819 Aux Id: ERL-944 </p> + </item> + </list> + </section> + +</section> + <section><title>Erts 10.3.5</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/erts/emulator/beam/atom.c b/erts/emulator/beam/atom.c index 59b51fd15e..5a70509ffd 100644 --- a/erts/emulator/beam/atom.c +++ b/erts/emulator/beam/atom.c @@ -200,11 +200,15 @@ atom_free(Atom* obj) ASSERT(obj->slot.index == atom_val(am_ErtsSecretAtom)); } -static void latin1_to_utf8(byte* conv_buf, const byte** srcp, int* lenp) +static void latin1_to_utf8(byte* conv_buf, Uint buf_sz, + const byte** srcp, Uint* lenp) { byte* dst; const byte* src = *srcp; - int i, len = *lenp; + Uint i, len = *lenp; + + ASSERT(len <= MAX_ATOM_CHARACTERS); + ASSERT(buf_sz >= MAX_ATOM_SZ_FROM_LATIN1); for (i=0 ; i < len; ++i) { if (src[i] & 0x80) { @@ -234,11 +238,11 @@ need_convertion: * erts_atom_put_index() may fail. Returns negative indexes for errors. */ int -erts_atom_put_index(const byte *name, int len, ErtsAtomEncoding enc, int trunc) +erts_atom_put_index(const byte *name, Sint len, ErtsAtomEncoding enc, int trunc) { byte utf8_copy[MAX_ATOM_SZ_FROM_LATIN1]; const byte *text = name; - int tlen = len; + Uint tlen; Sint no_latin1_chars; Atom a; int aix; @@ -247,13 +251,16 @@ erts_atom_put_index(const byte *name, int len, ErtsAtomEncoding enc, int trunc) erts_atomic_inc_nob(&atom_put_ops); #endif - if (tlen < 0) { - if (trunc) - tlen = 0; - else - return ATOM_MAX_CHARS_ERROR; + if (len < 0) { + if (trunc) { + len = 0; + } else { + return ATOM_MAX_CHARS_ERROR; + } } + tlen = len; + switch (enc) { case ERTS_ATOM_ENC_7BIT_ASCII: if (tlen > MAX_ATOM_CHARACTERS) { @@ -277,7 +284,7 @@ erts_atom_put_index(const byte *name, int len, ErtsAtomEncoding enc, int trunc) return ATOM_MAX_CHARS_ERROR; } no_latin1_chars = tlen; - latin1_to_utf8(utf8_copy, &text, &tlen); + latin1_to_utf8(utf8_copy, sizeof(utf8_copy), &text, &tlen); break; case ERTS_ATOM_ENC_UTF8: /* First sanity check; need to verify later */ @@ -338,7 +345,7 @@ erts_atom_put_index(const byte *name, int len, ErtsAtomEncoding enc, int trunc) * erts_atom_put() may fail. If it fails THE_NON_VALUE is returned! */ Eterm -erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc) +erts_atom_put(const byte *name, Sint len, ErtsAtomEncoding enc, int trunc) { int aix = erts_atom_put_index(name, len, enc, trunc); if (aix >= 0) @@ -348,7 +355,7 @@ erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc) } Eterm -am_atom_put(const char* name, int len) +am_atom_put(const char* name, Sint len) { /* Assumes 7-bit ascii; use erts_atom_put() for other encodings... */ return erts_atom_put((byte *) name, len, ERTS_ATOM_ENC_7BIT_ASCII, 1); @@ -379,23 +386,57 @@ int atom_table_sz(void) } int -erts_atom_get(const char *name, int len, Eterm* ap, ErtsAtomEncoding enc) +erts_atom_get(const char *name, Uint len, Eterm* ap, ErtsAtomEncoding enc) { byte utf8_copy[MAX_ATOM_SZ_FROM_LATIN1]; Atom a; int i; int res; - a.len = (Sint16) len; - a.name = (byte *)name; - if (enc == ERTS_ATOM_ENC_LATIN1) { - latin1_to_utf8(utf8_copy, (const byte**)&a.name, &len); - a.len = (Sint16) len; + switch (enc) { + case ERTS_ATOM_ENC_LATIN1: + if (len > MAX_ATOM_CHARACTERS) { + return 0; + } + + latin1_to_utf8(utf8_copy, sizeof(utf8_copy), (const byte**)&name, &len); + + a.name = (byte*)name; + a.len = (Sint16)len; + break; + case ERTS_ATOM_ENC_7BIT_ASCII: + if (len > MAX_ATOM_CHARACTERS) { + return 0; + } + + for (i = 0; i < len; i++) { + if (name[i] & 0x80) { + return 0; + } + } + + a.len = (Sint16)len; + a.name = (byte*)name; + break; + case ERTS_ATOM_ENC_UTF8: + if (len > MAX_ATOM_SZ_LIMIT) { + return 0; + } + + /* We don't need to check whether the encoding is legal as all atom + * names are stored as UTF-8 and we know a lookup with a badly encoded + * name will fail. */ + + a.len = (Sint16)len; + a.name = (byte*)name; + break; } + atom_read_lock(); i = index_get(&erts_atom_table, (void*) &a); res = i < 0 ? 0 : (*ap = make_atom(i), 1); atom_read_unlock(); + return res; } diff --git a/erts/emulator/beam/atom.h b/erts/emulator/beam/atom.h index ca920679c6..f51c5a8c62 100644 --- a/erts/emulator/beam/atom.h +++ b/erts/emulator/beam/atom.h @@ -133,14 +133,14 @@ typedef enum { int atom_table_size(void); /* number of elements */ int atom_table_sz(void); /* table size in bytes, excluding stored objects */ -Eterm am_atom_put(const char*, int); /* ONLY 7-bit ascii! */ -Eterm erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc); -int erts_atom_put_index(const byte *name, int len, ErtsAtomEncoding enc, int trunc); +Eterm am_atom_put(const char*, Sint); /* ONLY 7-bit ascii! */ +Eterm erts_atom_put(const byte *name, Sint len, ErtsAtomEncoding enc, int trunc); +int erts_atom_put_index(const byte *name, Sint len, ErtsAtomEncoding enc, int trunc); void init_atom_table(void); void atom_info(fmtfn_t, void *); void dump_atoms(fmtfn_t, void *); Uint erts_get_atom_limit(void); -int erts_atom_get(const char* name, int len, Eterm* ap, ErtsAtomEncoding enc); +int erts_atom_get(const char* name, Uint len, Eterm* ap, ErtsAtomEncoding enc); void erts_atom_get_text_space_sizes(Uint *reserved, Uint *used); #endif diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index d7bcf61a53..c861bb21ca 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -675,6 +675,7 @@ atom unload_cancelled atom value atom version atom visible +atom wait_release_literal_area_switch atom waiting atom wall_clock atom warning diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index bb1b2e5b27..1c5ed9d30b 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -66,24 +66,6 @@ static struct { Process *erts_code_purger = NULL; -erts_atomic_t erts_copy_literal_area__; -#define ERTS_SET_COPY_LITERAL_AREA(LA) \ - erts_atomic_set_nob(&erts_copy_literal_area__, \ - (erts_aint_t) (LA)) -Process *erts_literal_area_collector = NULL; - -typedef struct ErtsLiteralAreaRef_ ErtsLiteralAreaRef; -struct ErtsLiteralAreaRef_ { - ErtsLiteralAreaRef *next; - ErtsLiteralArea *literal_area; -}; - -struct { - erts_mtx_t mtx; - ErtsLiteralAreaRef *first; - ErtsLiteralAreaRef *last; -} release_literal_areas; - static void set_default_trace_pattern(Eterm module); static Eterm check_process_code(Process* rp, Module* modp, int *redsp, int fcalls); static void delete_code(Module* modp); @@ -114,17 +96,13 @@ init_purge_state(void) purge_state.saved_old.code_hdr = 0; } +static void +init_release_literal_areas(void); + void erts_beam_bif_load_init(void) { - erts_mtx_init(&release_literal_areas.mtx, "release_literal_areas", NIL, - ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC); - - release_literal_areas.first = NULL; - release_literal_areas.last = NULL; - erts_atomic_init_nob(&erts_copy_literal_area__, - (erts_aint_t) NULL); - + init_release_literal_areas(); init_purge_state(); } @@ -622,7 +600,7 @@ BIF_RETTYPE erts_internal_check_dirty_process_code_2(BIF_ALIST_2) if (BIF_ARG_1 == BIF_P->common.id) BIF_RET(am_normal); - rp = erts_proc_lookup_raw(BIF_ARG_1); + rp = erts_proc_lookup(BIF_ARG_1); if (!rp) BIF_RET(am_false); @@ -637,7 +615,9 @@ BIF_RETTYPE erts_internal_check_dirty_process_code_2(BIF_ALIST_2) if (busy) BIF_RET(am_busy); - res = erts_check_process_code(rp, BIF_ARG_2, &reds, BIF_P->fcalls); + res = (ERTS_PROC_IS_EXITING(rp) + ? am_false + : erts_check_process_code(rp, BIF_ARG_2, &reds, BIF_P->fcalls)); erts_proc_unlock(rp, ERTS_PROC_LOCK_MAIN); @@ -922,7 +902,7 @@ msg_copy_literal_area(ErtsMessage *msgp, int *redsp, *redsp += 1; - if (!ERTS_SIG_IS_INTERNAL_MSG(msgp) || !msgp->data.attached) + if (!ERTS_SIG_IS_INTERNAL_MSG(msgp)) return; if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG) @@ -930,6 +910,23 @@ msg_copy_literal_area(ErtsMessage *msgp, int *redsp, else hfrag = msgp->data.heap_frag; + /* + * Literals should only be able to appear in the + * first message reference, i.e., the message + * itself... + */ + if (ErtsInArea(msgp->m[0], literals, lit_bsize)) + lit_sz += size_object(msgp->m[0]); + +#ifdef DEBUG + { + int i; + for (i = 1; i < ERL_MESSAGE_REF_ARRAY_SZ; i++) { + ASSERT(!ErtsInArea(msgp->m[i], literals, lit_bsize)); + } + } +#endif + for (hf = hfrag; hf; hf = hf->next) { lit_sz += hfrag_literal_size(&hf->mem[0], &hf->mem[hf->used_size], @@ -942,6 +939,11 @@ msg_copy_literal_area(ErtsMessage *msgp, int *redsp, ErlHeapFragment *bp = new_message_buffer(lit_sz); Eterm *hp = bp->mem; + if (ErtsInArea(msgp->m[0], literals, lit_bsize)) { + Uint sz = size_object(msgp->m[0]); + msgp->m[0] = copy_struct(msgp->m[0], sz, &hp, &bp->off_heap); + } + for (hf = hfrag; hf; hf = hf->next) { hfrag_literal_copy(&hp, &bp->off_heap, &hf->mem[0], @@ -950,10 +952,14 @@ msg_copy_literal_area(ErtsMessage *msgp, int *redsp, hfrag = hf; } - /* link new hfrag last */ - ASSERT(hfrag->next == NULL); - hfrag->next = bp; bp->next = NULL; + /* link new hfrag last */ + if (!hfrag) + msgp->data.heap_frag = bp; + else { + ASSERT(hfrag->next == NULL); + hfrag->next = bp; + } } } @@ -971,6 +977,14 @@ erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed if (!la) goto return_ok; + /* The heap may be in an inconsistent state when the GC is disabled, for + * example when we're in the middle of building a record in + * binary_to_term/1, so we have to delay scanning until the GC is enabled + * again. */ + if (c_p->flags & F_DISABLE_GC) { + return THE_NON_VALUE; + } + oh = la->off_heap; literals = (char *) &la->start[0]; lit_bsize = (char *) la->end - literals; @@ -1091,9 +1105,6 @@ literal_gc: if (!gc_allowed) return am_need_gc; - if (c_p->flags & F_DISABLE_GC) - return THE_NON_VALUE; - *redsp += erts_garbage_collect_literals(c_p, (Eterm *) literals, lit_bsize, oh, fcalls); @@ -1328,6 +1339,67 @@ hfrag_literal_copy(Eterm **hpp, ErlOffHeap *ohp, } } +/* + * Release of literal areas... + * + * Overview over how literal areas are released. + * + * - A literal area to remove is placed in the release_literal_areas.first + * queue. + * - The erts_literal_area_collector process is woken and calls + * erts_internal:release_literal_area_switch() which publishes the + * area to release available to the emulator + * (ERTS_COPY_LITERAL_AREA()). + * - The literal area collector process gets suspended waiting thread + * progress in order to ensure all schedulers see the newly published + * area to release. + * - When the literal area collector process is resumed after thread + * progress has completed, erts_internal:release_literal_area_switch() + * returns 'true'. + * - The literal area collector process sends copy-literals requests + * to all processes in the system. + * - Processes inspects their heap for literals in the area, if + * such are found do a literal-gc to make copies on the heap + * of all those literals, and then send replies to the + * literal area collector process. + * - Processes that terminates replies even though they might need to + * access literal areas. When a process that might need to access a + * literal area terminates, it blocks release of literal areas + * by incrementing a counter, and later when termination has + * completed decrements that counter. The increment is performed + * before replying to the copy-literals request. + * - When all processes has responded, the literal area collector + * process calls erts_internal:release_literal_area_switch() again + * in order to switch to the next area. + * - erts_internal:release_literal_area_switch() changes the set of + * counters that blocks release of literal areas + * - The literal area collector process gets suspended waiting thread + * progress in order to ensure that the change of counters is visable + * by all schedulers. + * - When the literal area collector process is resumed after thread + * progress has completed, erts_internal:release_literal_area_switch() + * inspects all counters in previously used set ensuring that no + * terminating processes (which began termination before the change + * of counters) are lingering. If needed the literal area collector + * process will be blocked in + * erts_internal:release_literal_area_switch() waiting for all + * terminating processes to complete. + * - When counter inspection is complete + * erts_internal:release_literal_area_switch() returns 'true' if + * a new area was set for release and 'false' if no more areas have + * been scheduled for release. + * + * When multiple literal areas have been queued for release, + * erts_internal:release_literal_area_switch() will time the thread + * progress waits so each wait period will be utilized both for + * ensuring that a new area is seen by all schedulers, and ensuring + * that a change of counters is seen by all schedulers. By this only + * one thread progress wait will be done per literal area collected + * until the last literal area which will need two thread progress + * wait periods. + */ + +static Export *wait_release_literal_area_switch; ErtsThrPrgrLaterOp later_literal_area_switch; @@ -1336,36 +1408,202 @@ typedef struct { ErtsLiteralArea *la; } ErtsLaterReleasLiteralArea; +erts_atomic_t erts_copy_literal_area__; +#define ERTS_SET_COPY_LITERAL_AREA(LA) \ + erts_atomic_set_nob(&erts_copy_literal_area__, \ + (erts_aint_t) (LA)) +Process *erts_literal_area_collector = NULL; + +typedef struct ErtsLiteralAreaRef_ ErtsLiteralAreaRef; +struct ErtsLiteralAreaRef_ { + ErtsLiteralAreaRef *next; + ErtsLiteralArea *literal_area; +}; + +typedef struct { + erts_atomic_t counter[2]; +} ErtsReleaseLiteralAreaBlockCounters; + +typedef struct { + union { + ErtsReleaseLiteralAreaBlockCounters block; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsReleaseLiteralAreaBlockCounters))]; + } u; +} ErtsAlignedReleaseLiteralAreaBlockCounters; + +typedef enum { + ERTS_RLA_BLOCK_STATE_NONE, + ERTS_RLA_BLOCK_STATE_SWITCHED_IX, + ERTS_RLA_BLOCK_STATE_WAITING +} ErtsReleaseLiteralAreaBlockState; + +static struct { + erts_mtx_t mtx; + ErtsLiteralAreaRef *first; + ErtsLiteralAreaRef *last; + ErtsAlignedReleaseLiteralAreaBlockCounters *bc; + erts_atomic32_t block_ix; + int wait_sched_ix; + ErtsReleaseLiteralAreaBlockState block_state; + ErtsLiteralArea *block_area; +} release_literal_areas; + static void -later_release_literal_area(void *vlrlap) +init_release_literal_areas(void) { - ErtsLaterReleasLiteralArea *lrlap; - lrlap = (ErtsLaterReleasLiteralArea *) vlrlap; - erts_release_literal_area(lrlap->la); - erts_free(ERTS_ALC_T_RELEASE_LAREA, vlrlap); + int i; + erts_mtx_init(&release_literal_areas.mtx, "release_literal_areas", NIL, + ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC); + + release_literal_areas.first = NULL; + release_literal_areas.last = NULL; + erts_atomic_init_nob(&erts_copy_literal_area__, + (erts_aint_t) NULL); + + erts_atomic32_init_nob(&release_literal_areas.block_ix, 0); + release_literal_areas.wait_sched_ix = 0; + release_literal_areas.block_state = ERTS_RLA_BLOCK_STATE_NONE; + release_literal_areas.block_area = NULL; + + release_literal_areas.bc = + erts_alloc_permanent_cache_aligned(ERTS_ALC_T_RLA_BLOCK_CNTRS, + sizeof(ErtsAlignedReleaseLiteralAreaBlockCounters) + * erts_no_schedulers); + /* + * The literal-area-collector has an increment in all block counters + * which it only removes when waiting for other increments to disappear. + */ + for (i = 0; i < erts_no_schedulers; i++) { + erts_atomic_init_nob(&release_literal_areas.bc[i].u.block.counter[0], 1); + erts_atomic_init_nob(&release_literal_areas.bc[i].u.block.counter[1], 1); + } + + wait_release_literal_area_switch = erts_export_put(am_erts_internal, + am_wait_release_literal_area_switch, + 1); } static void -complete_literal_area_switch(void *literal_area) +rla_resume(void *literal_area) { - Process *p = erts_literal_area_collector; - erts_proc_lock(p, ERTS_PROC_LOCK_STATUS); - erts_resume(p, ERTS_PROC_LOCK_STATUS); - erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS); - if (literal_area) - erts_release_literal_area((ErtsLiteralArea *) literal_area); + erts_resume(erts_literal_area_collector, 0); } -BIF_RETTYPE erts_internal_release_literal_area_switch_0(BIF_ALIST_0) + +static ERTS_INLINE Sint +rla_bc_read(int sched_ix, int block_ix) { - ErtsLiteralArea *unused_la; - ErtsLiteralAreaRef *la_ref; + return (Sint) erts_atomic_read_nob( + &release_literal_areas.bc[sched_ix].u.block.counter[block_ix]); +} - if (BIF_P != erts_literal_area_collector) - BIF_ERROR(BIF_P, EXC_NOTSUP); +static ERTS_INLINE Sint +rla_bc_read_acqb(int sched_ix, int block_ix) +{ + return (Sint) erts_atomic_read_acqb( + &release_literal_areas.bc[sched_ix].u.block.counter[block_ix]); +} - erts_mtx_lock(&release_literal_areas.mtx); +static ERTS_INLINE Sint +rla_bc_dec_read_acqb(int sched_ix, int block_ix) +{ + return (Sint) erts_atomic_dec_read_acqb( + &release_literal_areas.bc[sched_ix].u.block.counter[block_ix]); +} + +static ERTS_INLINE Sint +rla_bc_dec_read_relb(int sched_ix, int block_ix) +{ + return (Sint) erts_atomic_dec_read_relb( + &release_literal_areas.bc[sched_ix].u.block.counter[block_ix]); +} + +static ERTS_INLINE void +rla_bc_inc(int sched_ix, int block_ix) +{ + erts_atomic_inc_nob( + &release_literal_areas.bc[sched_ix].u.block.counter[block_ix]); +} + +Uint32 +erts_block_release_literal_area(void) +{ + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + int sched_ix; + int block_ix; + + ASSERT(esdp->type == ERTS_SCHED_NORMAL); + + sched_ix = ((int) esdp->no) - 1; + ASSERT((sched_ix & ~0xffff) == 0); + + ASSERT(0 <= sched_ix && sched_ix <= erts_no_schedulers); + + block_ix = (int) erts_atomic32_read_nob(&release_literal_areas.block_ix); + ASSERT(block_ix == 0 || block_ix == 1); + + rla_bc_inc(sched_ix, block_ix); + + /* + * The returned value needs to be non-zero, so the user can + * use zero as a marker for not having blocked. + * + * Both block_ix and sched_ix can be zero so we set + * the highest (unused) bits to 0xfed00000 + */ + return (Uint32) 0xfed00000 | ((block_ix << 16) | sched_ix); +} + +static void +wakeup_literal_area_collector(void *unused) +{ + erts_queue_message(erts_literal_area_collector, + 0, + erts_alloc_message(0, NULL), + am_copy_literals, + am_system); +} + +void +erts_unblock_release_literal_area(Uint32 sched_block_ix) +{ + Sint block_count; + int block_ix = (int) ((sched_block_ix >> 16) & 0xf); + int sched_ix = (int) (sched_block_ix & 0xffff); + + ASSERT((sched_block_ix & ((Uint32) 0xfff00000)) + == (Uint32) 0xfed00000); + + ASSERT(block_ix == 0 || block_ix == 1); + + block_count = rla_bc_dec_read_relb(sched_ix, block_ix); + + ASSERT(block_count >= 0); + + if (!block_count) { + /* + * Wakeup literal collector so it can continue... + * + * We don't know what locks we have here, so schedule + * the operation... + */ + int sid = 1; + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + if (esdp && esdp->type == ERTS_SCHED_NORMAL) + sid = (int) esdp->no; + erts_schedule_misc_aux_work(sid, + wakeup_literal_area_collector, + NULL); + } +} + +static void +rla_switch_area(void) +{ + ErtsLiteralAreaRef *la_ref; + + erts_mtx_lock(&release_literal_areas.mtx); la_ref = release_literal_areas.first; if (la_ref) { release_literal_areas.first = la_ref->next; @@ -1375,38 +1613,171 @@ BIF_RETTYPE erts_internal_release_literal_area_switch_0(BIF_ALIST_0) erts_mtx_unlock(&release_literal_areas.mtx); - unused_la = ERTS_COPY_LITERAL_AREA(); - - if (!la_ref) { - ERTS_SET_COPY_LITERAL_AREA(NULL); - if (unused_la) { - ErtsLaterReleasLiteralArea *lrlap; - lrlap = erts_alloc(ERTS_ALC_T_RELEASE_LAREA, - sizeof(ErtsLaterReleasLiteralArea)); - lrlap->la = unused_la; - erts_schedule_thr_prgr_later_cleanup_op( - later_release_literal_area, - (void *) lrlap, - &lrlap->lop, - (sizeof(ErtsLaterReleasLiteralArea) - + sizeof(ErtsLiteralArea) - + ((unused_la->end - - &unused_la->start[0]) - - 1)*(sizeof(Eterm)))); - } - BIF_RET(am_false); + if (!la_ref) + ERTS_SET_COPY_LITERAL_AREA(NULL); + else { + ERTS_SET_COPY_LITERAL_AREA(la_ref->literal_area); + erts_free(ERTS_ALC_T_LITERAL_REF, la_ref); } +} + +BIF_RETTYPE erts_internal_release_literal_area_switch_0(BIF_ALIST_0) +{ + ErtsLiteralArea *new_area, *old_area; + int wait_ix = 0; + int sched_ix = 0; + + if (BIF_P != erts_literal_area_collector) + BIF_ERROR(BIF_P, EXC_NOTSUP); + + while (1) { + int six; + + switch (release_literal_areas.block_state) { + case ERTS_RLA_BLOCK_STATE_NONE: { + + old_area = ERTS_COPY_LITERAL_AREA(); + + rla_switch_area(); + + if (old_area) { + int block_ix; + /* + * Switch block index. + */ + block_ix = (int) erts_atomic32_read_nob(&release_literal_areas.block_ix); + erts_atomic32_set_nob(&release_literal_areas.block_ix, + (erts_aint32_t) !block_ix); + release_literal_areas.block_state = ERTS_RLA_BLOCK_STATE_SWITCHED_IX; + ASSERT(!release_literal_areas.block_area); + release_literal_areas.block_area = old_area; + } + + new_area = ERTS_COPY_LITERAL_AREA(); + + if (!old_area && !new_area) + BIF_RET(am_false); + + publish_new_info: + + /* + * Waiting 'thread progress' will ensure that all schedulers are + * guaranteed to see the new block index and the new area before + * we continue... + */ + erts_schedule_thr_prgr_later_op(rla_resume, + NULL, + &later_literal_area_switch); + erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL); + if (new_area) { + /* + * If we also got a new block_area, we will + * take care of that the next time we come back + * after all processes has responded on + * copy-literals requests... + */ + ERTS_BIF_YIELD_RETURN(BIF_P, + am_true); + } + + ASSERT(old_area); + ERTS_VBUMP_ALL_REDS(BIF_P); + BIF_TRAP0(bif_export[BIF_erts_internal_release_literal_area_switch_0], + BIF_P); + } + + case ERTS_RLA_BLOCK_STATE_SWITCHED_IX: + wait_ix = !erts_atomic32_read_nob(&release_literal_areas.block_ix); + /* + * Now all counters in the old index will monotonically + * decrease towards 1 (our own increment). Check that we + * have no other increments, than our own, in all counters + * of the old block index. Wait for other increments to + * be decremented if necessary... + */ + sched_ix = 0; + break; + + case ERTS_RLA_BLOCK_STATE_WAITING: + wait_ix = !erts_atomic32_read_nob(&release_literal_areas.block_ix); + /* + * Woken after being waiting for a counter to reach zero... + */ + sched_ix = release_literal_areas.wait_sched_ix; + /* restore "our own increment" */ + rla_bc_inc(sched_ix, wait_ix); + break; + } + + ASSERT(0 <= sched_ix && sched_ix < erts_no_schedulers); + +#ifdef DEBUG + for (six = 0; six < sched_ix; six++) { + ASSERT(1 == rla_bc_read(six, wait_ix)); + } +#endif + + for (six = sched_ix; six < erts_no_schedulers; six++) { + Sint block_count = rla_bc_read_acqb(six, wait_ix); + ASSERT(block_count >= 1); + if (block_count == 1) + continue; + + block_count = rla_bc_dec_read_acqb(six, wait_ix); + if (!block_count) { + /* + * We brought it down to zero ourselves, so no need to wait. + * Since the counter is guaranteed to be monotonically + * decreasing (disregarding our own operations) it is safe + * to continue. Restore "our increment" in preparation for + * next switch. + */ + rla_bc_inc(six, wait_ix); + continue; + } + + /* + * Wait for counter to be brought down to zero. The one bringing + * the counter down to zero will wake us up. We might also be + * woken later in erts_internal:wait_release_literal_area_switch() + * if a new area appears (handled here below). + */ + release_literal_areas.wait_sched_ix = six; + release_literal_areas.block_state = ERTS_RLA_BLOCK_STATE_WAITING; + if (!ERTS_COPY_LITERAL_AREA()) { + rla_switch_area(); + new_area = ERTS_COPY_LITERAL_AREA(); + if (new_area) { + /* + * A new area showed up. Start the work with that area + * and come back and check block counters when that has + * been handled. + */ + old_area = release_literal_areas.block_area; + goto publish_new_info; + } + } - ERTS_SET_COPY_LITERAL_AREA(la_ref->literal_area); + /* + * Wait for block_counter to reach zero or a new literal area + * to handle... + */ + BIF_TRAP1(wait_release_literal_area_switch, BIF_P, am_copy_literals); + } - erts_free(ERTS_ALC_T_LITERAL_REF, la_ref); + /* Done checking all block counters, release the literal area... */ - erts_schedule_thr_prgr_later_op(complete_literal_area_switch, - unused_la, - &later_literal_area_switch); - erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL); - ERTS_BIF_YIELD_RETURN(BIF_P, am_true); + release_literal_areas.block_state = ERTS_RLA_BLOCK_STATE_NONE; + erts_release_literal_area(release_literal_areas.block_area); + release_literal_areas.block_area = NULL; +#ifdef DEBUG + /* All counters should be at 1; ready for next switch... */ + for (six = 0; six < erts_no_schedulers; six++) { + ASSERT(1 == rla_bc_read(six, wait_ix)); + } +#endif + } } void @@ -1799,6 +2170,38 @@ erts_queue_release_literals(Process* c_p, ErtsLiteralArea* literals) } } +void +erts_debug_foreach_release_literal_area_off_heap(void (*func)(ErlOffHeap *, void *), void *arg) +{ + int i; + ErtsLiteralArea *lareas[2]; + ErtsLiteralArea *lap; + ErlOffHeap oh; + ErtsLiteralAreaRef *ref; + erts_mtx_lock(&release_literal_areas.mtx); + for (ref = release_literal_areas.first; ref; ref = ref->next) { + lap = ref->literal_area; + if (!erts_debug_have_accessed_literal_area(lap)) { + ERTS_INIT_OFF_HEAP(&oh); + oh.first = lap->off_heap; + (*func)(&oh, arg); + erts_debug_save_accessed_literal_area(lap); + } + } + erts_mtx_unlock(&release_literal_areas.mtx); + lareas[0] = ERTS_COPY_LITERAL_AREA(); + lareas[1] = release_literal_areas.block_area; + for (i = 0; i < sizeof(lareas)/sizeof(lareas[0]); i++) { + lap = lareas[i]; + if (lap && !erts_debug_have_accessed_literal_area(lap)) { + ERTS_INIT_OFF_HEAP(&oh); + oh.first = lap->off_heap; + (*func)(&oh, arg); + erts_debug_save_accessed_literal_area(lap); + } + } +} + /* * Move code from current to old and null all export entries for the module */ diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 3af0838794..ec4f9b4339 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -422,6 +422,7 @@ static Eterm add_stacktrace(Process* c_p, Eterm Value, Eterm exc); static void save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, ErtsCodeMFA *bif_mfa, Eterm args); static struct StackTrace * get_trace_from_exc(Eterm exc); +static Eterm *get_freason_ptr_from_exc(Eterm exc); static Eterm make_arglist(Process* c_p, Eterm* reg, int a); void @@ -1904,6 +1905,25 @@ static int is_raised_exc(Eterm exc) { } } +static Eterm *get_freason_ptr_from_exc(Eterm exc) { + static Eterm dummy_freason; + struct StackTrace* s; + + if (exc == NIL) { + /* + * Is is not exactly clear when exc can be NIL. Probably only + * when the exception has been generated from native code. + * Return a pointer to an Eterm that can be safely written and + * ignored. + */ + return &dummy_freason; + } else { + ASSERT(is_list(exc)); + s = (struct StackTrace *) big_val(CDR(list_val(exc))); + return &s->freason; + } +} + /* * Creating a list with the argument registers */ diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index e61199a8fd..725b8006f7 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -4547,7 +4547,15 @@ typedef struct SortGenOpArg { static int genopargtermcompare(SortGenOpArg* a, SortGenOpArg* b) { - return CMP_TERM(a->term, b->term); + Sint res = CMP_TERM(a->term, b->term); + + if (res < 0) { + return -1; + } else if (res > 0) { + return 1; + } + + return 0; } static int diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index b9cce0022d..e4e6d7446f 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -4235,12 +4235,16 @@ BIF_RETTYPE list_to_ref_1(BIF_ALIST_1) #endif etp = (ExternalThing *) HAlloc(BIF_P, hsz); - etp->header = make_external_ref_header(n/2); +#if defined(ARCH_64) + etp->header = make_external_ref_header(n/2 + 1); +#else + etp->header = make_external_ref_header(n); +#endif etp->next = BIF_P->off_heap.first; etp->node = enp; i = 0; #if defined(ARCH_64) - etp->data.ui32[i] = n; + etp->data.ui32[i++] = n; #endif for (j = 0; j < n; j++) { etp->data.ui32[i] = refn[j]; diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index e7bd046e18..5314aeeee1 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -1238,11 +1238,25 @@ Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info) } else { extra_bytes = 0; } - ASSERT(is_boxed(real_bin) && - (((*boxed_val(real_bin)) & - (_TAG_HEADER_MASK - _BINARY_XXX_MASK - BOXED_VISITED_MASK)) - == _TAG_HEADER_REFC_BIN)); - hdr = *_unchecked_binary_val(real_bin) & ~BOXED_VISITED_MASK; + ASSERT(is_boxed(real_bin)); + hdr = *_unchecked_binary_val(real_bin); + switch (primary_tag(hdr)) { + case TAG_PRIMARY_HEADER: + /* real_bin is untouched, only referred by sub-bins so far */ + break; + case BOXED_VISITED: + /* real_bin referred directly once so far */ + hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER; + break; + case BOXED_SHARED_PROCESSED: + case BOXED_SHARED_UNPROCESSED: + /* real_bin referred directly more than once */ + e = hdr >> _TAG_PRIMARY_SIZE; + hdr = SHTABLE_X(t, e); + hdr = (hdr & ~BOXED_VISITED_MASK) + TAG_PRIMARY_HEADER; + break; + } + if (thing_subtag(hdr) == HEAP_BINARY_SUBTAG) { sum += heap_bin_size(size+extra_bytes); } else { @@ -1611,11 +1625,6 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, extra_bytes = 0; } real_size = size+extra_bytes; - ASSERT(is_boxed(real_bin) && - (((*boxed_val(real_bin)) & - (_TAG_HEADER_MASK - _BINARY_XXX_MASK - BOXED_VISITED_MASK)) - == _TAG_HEADER_REFC_BIN)); - ptr = _unchecked_binary_val(real_bin); *resp = make_binary(hp); if (extra_bytes != 0) { ErlSubBin* res = (ErlSubBin *) hp; @@ -1628,7 +1637,26 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, res->is_writable = 0; res->orig = make_binary(hp); } - if (thing_subtag(*ptr & ~BOXED_VISITED_MASK) == HEAP_BINARY_SUBTAG) { + ASSERT(is_boxed(real_bin)); + ptr = _unchecked_binary_val(real_bin); + hdr = *ptr; + switch (primary_tag(hdr)) { + case TAG_PRIMARY_HEADER: + /* real_bin is untouched, ie only referred by sub-bins */ + break; + case BOXED_VISITED: + /* real_bin referred directly once */ + hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER; + break; + case BOXED_SHARED_PROCESSED: + case BOXED_SHARED_UNPROCESSED: + /* real_bin referred directly more than once */ + e = hdr >> _TAG_PRIMARY_SIZE; + hdr = SHTABLE_X(t, e); + hdr = (hdr & ~BOXED_VISITED_MASK) + TAG_PRIMARY_HEADER; + break; + } + if (thing_subtag(hdr) == HEAP_BINARY_SUBTAG) { ErlHeapBin* from = (ErlHeapBin *) ptr; ErlHeapBin* to = (ErlHeapBin *) hp; hp += heap_bin_size(real_size); @@ -1638,7 +1666,7 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, } else { ProcBin* from = (ProcBin *) ptr; ProcBin* to = (ProcBin *) hp; - ASSERT(thing_subtag(*ptr & ~BOXED_VISITED_MASK) == REFC_BINARY_SUBTAG); + ASSERT(thing_subtag(hdr) == REFC_BINARY_SUBTAG); if (from->flags) { erts_emasculate_writable_binary(from); } diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 0633bff3c2..aff5a84c53 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -1343,22 +1343,22 @@ int erts_net_message(Port *prt, from, to); ASSERT(ldp->a.other.item == to); ASSERT(eq(ldp->b.other.item, from)); -#ifdef DEBUG - code = -#endif - erts_link_dist_insert(&ldp->a, dep->mld); - ASSERT(code); - if (erts_proc_sig_send_link(NULL, to, &ldp->b)) - break; /* done */ + code = erts_link_dist_insert(&ldp->a, ede.mld); + if (erts_proc_sig_send_link(NULL, to, &ldp->b)) { + if (!code) { + /* Race: connection already down => send link exit */ + erts_proc_sig_send_link_exit(NULL, THE_NON_VALUE, &ldp->a, + am_noconnection, NIL); + } + break; /* Done */ + } /* Failed to send signal; cleanup and reply noproc... */ - -#ifdef DEBUG - code = -#endif - erts_link_dist_delete(&ldp->a); - ASSERT(code); + if (code) { + code = erts_link_dist_delete(&ldp->a); + ASSERT(code); + } erts_link_release_both(ldp); } @@ -1438,8 +1438,11 @@ int erts_net_message(Port *prt, mdp = erts_monitor_create(ERTS_MON_TYPE_DIST_PROC, ref, watcher, pid, name); - code = erts_monitor_dist_insert(&mdp->origin, dep->mld); - ASSERT(code); (void)code; + if (!erts_monitor_dist_insert(&mdp->origin, ede.mld)) { + /* Race: connection down => do nothing */ + erts_monitor_release_both(mdp); + break; + } if (erts_proc_sig_send_monitor(&mdp->target, pid)) break; /* done */ @@ -1490,16 +1493,17 @@ int erts_net_message(Port *prt, ; } else if (is_atom(watched)) { - ErtsMonLnkDist *mld = dep->mld; ErtsMonitor *mon; - erts_mtx_lock(&mld->mtx); - - mon = erts_monitor_tree_lookup(mld->orig_name_monitors, ref); - if (mon) - erts_monitor_tree_delete(&mld->orig_name_monitors, mon); - - erts_mtx_unlock(&mld->mtx); + erts_mtx_lock(&ede.mld->mtx); + if (ede.mld->alive) { + mon = erts_monitor_tree_lookup(ede.mld->orig_name_monitors, ref); + if (mon) + erts_monitor_tree_delete(&ede.mld->orig_name_monitors, mon); + } + else + mon = NULL; + erts_mtx_unlock(&ede.mld->mtx); if (mon) erts_proc_sig_send_demonitor(mon); @@ -1713,9 +1717,17 @@ int erts_net_message(Port *prt, token = tuple[4]; reason = tuple[5]; } - if (is_not_pid(from) || is_not_internal_pid(to)) { + if (is_not_pid(from)) { goto invalid_message; } + if (is_not_internal_pid(to)) { + if (is_external_pid(to)) { + DistEntry *dep = external_pid_dist_entry(to); + if (dep == erts_this_dist_entry) + break; /* Old incarnation of this node... */ + } + goto invalid_message; + } erts_proc_sig_send_exit(NULL, from, to, reason, token, 0); break; diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 4f03a34390..5cdf447cc6 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -249,6 +249,7 @@ type MINDIRECTION FIXED_SIZE SYSTEM magic_indirection type BINARY_FIND SHORT_LIVED PROCESSES binary_find type CRASH_DUMP STANDARD SYSTEM crash_dump type DIST_TRANSCODE SHORT_LIVED SYSTEM dist_transcode_context +type RLA_BLOCK_CNTRS LONG_LIVED SYSTEM release_literal_area_block_counters type THR_Q_EL STANDARD SYSTEM thr_q_element type THR_Q_EL_SL FIXED_SIZE SYSTEM sl_thr_q_element @@ -353,6 +354,7 @@ type NIF_SEL_D_STATE FIXED_SIZE SYSTEM enif_select_data_state type POLLSET LONG_LIVED SYSTEM pollset type POLLSET_UPDREQ SHORT_LIVED SYSTEM pollset_update_req type POLL_FDS LONG_LIVED SYSTEM poll_fds +type BLOCK_PTHR_DATA LONG_LIVED SYSTEM block_poll_thread_data type FD_STATUS LONG_LIVED SYSTEM fd_status type SELECT_FDS LONG_LIVED SYSTEM select_fds diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index 0be4562785..fa8d04f88c 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -6760,12 +6760,21 @@ static int blockscan_cpool_yielding(blockscan_t *state) return 0; } -static int blockscan_yield_helper(blockscan_t *state, - int (*yielding_op)(blockscan_t*)) +/* */ + +static int blockscan_finish(blockscan_t *state) { - /* Note that we don't check whether to abort here; only yielding_op knows - * whether the carrier is still in the list/pool. */ + if (ERTS_PROC_IS_EXITING(state->process)) { + state->abort(state->user_data); + return 0; + } + state->current_op = blockscan_finish; + + return state->finish(state->user_data); +} + +static void blockscan_lock_helper(blockscan_t *state) { if ((state->allocator)->thread_safe) { /* Locked scans have to be as short as possible. */ state->reductions = 1; @@ -6774,34 +6783,18 @@ static int blockscan_yield_helper(blockscan_t *state, } else { state->reductions = BLOCKSCAN_REDUCTIONS; } +} - if (yielding_op(state)) { - state->next_op = state->current_op; - } - +static void blockscan_unlock_helper(blockscan_t *state) { if ((state->allocator)->thread_safe) { erts_mtx_unlock(&(state->allocator)->mutex); } - - return 1; -} - -/* */ - -static int blockscan_finish(blockscan_t *state) -{ - if (ERTS_PROC_IS_EXITING(state->process)) { - state->abort(state->user_data); - return 0; - } - - state->current_op = blockscan_finish; - - return state->finish(state->user_data); } static int blockscan_sweep_sbcs(blockscan_t *state) { + blockscan_lock_helper(state); + if (state->current_op != blockscan_sweep_sbcs) { SET_CARRIER_HDR(&state->dummy_carrier, 0, SCH_SBC, state->allocator); state->current_clist = &(state->allocator)->sbc_list; @@ -6811,11 +6804,19 @@ static int blockscan_sweep_sbcs(blockscan_t *state) state->current_op = blockscan_sweep_sbcs; state->next_op = blockscan_finish; - return blockscan_yield_helper(state, blockscan_clist_yielding); + if (blockscan_clist_yielding(state)) { + state->next_op = state->current_op; + } + + blockscan_unlock_helper(state); + + return 1; } static int blockscan_sweep_mbcs(blockscan_t *state) { + blockscan_lock_helper(state); + if (state->current_op != blockscan_sweep_mbcs) { SET_CARRIER_HDR(&state->dummy_carrier, 0, SCH_MBC, state->allocator); state->current_clist = &(state->allocator)->mbc_list; @@ -6825,11 +6826,19 @@ static int blockscan_sweep_mbcs(blockscan_t *state) state->current_op = blockscan_sweep_mbcs; state->next_op = blockscan_sweep_sbcs; - return blockscan_yield_helper(state, blockscan_clist_yielding); + if (blockscan_clist_yielding(state)) { + state->next_op = state->current_op; + } + + blockscan_unlock_helper(state); + + return 1; } static int blockscan_sweep_cpool(blockscan_t *state) { + blockscan_lock_helper(state); + if (state->current_op != blockscan_sweep_cpool) { ErtsAlcCPoolData_t *sentinel; @@ -6841,7 +6850,13 @@ static int blockscan_sweep_cpool(blockscan_t *state) state->current_op = blockscan_sweep_cpool; state->next_op = blockscan_sweep_mbcs; - return blockscan_yield_helper(state, blockscan_cpool_yielding); + if (blockscan_cpool_yielding(state)) { + state->next_op = state->current_op; + } + + blockscan_unlock_helper(state); + + return 1; } static int blockscan_get_specific_allocator(int allocator_num, diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c index 44655ad5df..15a0705b63 100644 --- a/erts/emulator/beam/erl_async.c +++ b/erts/emulator/beam/erl_async.c @@ -318,6 +318,7 @@ static ERTS_INLINE ErtsAsync *async_get(ErtsThrQ_t *q, if (ERTS_THR_Q_DIRTY != erts_thr_q_clean(q)) { ErtsThrQFinDeQ_t tmp_fin_deq; + erts_tse_use(tse); erts_tse_reset(tse); chk_fin_deq: @@ -362,6 +363,7 @@ static ERTS_INLINE ErtsAsync *async_get(ErtsThrQ_t *q, break; } + erts_tse_return(tse); } } } @@ -429,9 +431,10 @@ static erts_tse_t *async_thread_init(ErtsAsyncQ *aq) ErtsThrQInit_t qinit = ERTS_THR_Q_INIT_DEFAULT; erts_tse_t *tse = erts_tse_fetch(); ERTS_DECLARE_DUMMY(Uint no); - ErtsThrPrgrCallbacks callbacks; + erts_tse_return(tse); + callbacks.arg = (void *) tse; callbacks.wakeup = async_wakeup; callbacks.prepare_wait = NULL; diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 5c58c68369..8e0d01e565 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -162,10 +162,10 @@ static Eterm current_stacktrace(ErtsHeapFactory *hfact, Process* rp, Uint reserve_size); static Eterm -bld_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh) +bld_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh, Eterm tail) { struct erl_off_heap_header* ohh; - Eterm res = NIL; + Eterm res = tail; Eterm tuple; for (ohh = oh->first; ohh; ohh = ohh->next) { @@ -761,7 +761,7 @@ static ErtsProcessInfoArgs pi_args[] = { {am_memory, 0, ERTS_PI_FLAG_NEED_MSGQ_LEN|ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN}, {am_garbage_collection, 3+2 + 3+2 + 3+2 + 3+2 + 3+2 + ERTS_MAX_HEAP_SIZE_MAP_SZ, 0, ERTS_PROC_LOCK_MAIN}, {am_group_leader, 0, 0, ERTS_PROC_LOCK_MAIN}, - {am_reductions, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN}, + {am_reductions, 0, 0, ERTS_PROC_LOCK_MAIN}, {am_priority, 0, 0, 0}, {am_trace, 0, 0, ERTS_PROC_LOCK_MAIN}, {am_binary, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN}, @@ -1860,11 +1860,25 @@ process_info_aux(Process *c_p, break; case ERTS_PI_IX_BINARY: { - Uint sz = 0; - (void) bld_bin_list(NULL, &sz, &MSO(rp)); + ErlHeapFragment *hfrag; + Uint sz; + + res = NIL; + sz = 0; + + (void)bld_bin_list(NULL, &sz, &MSO(rp), NIL); + for (hfrag = rp->mbuf; hfrag != NULL; hfrag = hfrag->next) { + (void)bld_bin_list(NULL, &sz, &hfrag->off_heap, NIL); + } + hp = erts_produce_heap(hfact, sz, reserve_size); - res = bld_bin_list(&hp, NULL, &MSO(rp)); - break; + + res = bld_bin_list(&hp, NULL, &MSO(rp), NIL); + for (hfrag = rp->mbuf; hfrag != NULL; hfrag = hfrag->next) { + res = bld_bin_list(&hp, NULL, &hfrag->off_heap, res); + } + + break; } case ERTS_PI_IX_SEQUENTIAL_TRACE_TOKEN: { @@ -3040,6 +3054,14 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) } else if (ERTS_IS_ATOM_STR("ethread_info", BIF_ARG_1)) { BIF_RET(erts_get_ethread_info(BIF_P)); } + else if (ERTS_IS_ATOM_STR("ethread_used_tse", BIF_ARG_1)) { + Uint64 no = (Uint64) ethr_no_used_tse(); + Uint hsz = 0; + erts_bld_uint64(NULL, &hsz, no); + hp = hsz ? HAlloc(BIF_P, hsz) : NULL; + res = erts_bld_uint64(&hp, NULL, no); + BIF_RET(res); + } else if (ERTS_IS_ATOM_STR("emu_args", BIF_ARG_1)) { BIF_RET(erts_get_emu_args(BIF_P)); } @@ -4400,6 +4422,28 @@ static void broken_halt_test(Eterm bif_arg_2) erts_exit(ERTS_DUMP_EXIT, "%T", bif_arg_2); } +static void +test_multizero_timeout_in_timeout3(void *vproc) +{ + Process *proc = (Process *) vproc; + ErtsMessage *mp = erts_alloc_message(0, NULL); + ERTS_DECL_AM(multizero_timeout_in_timeout_done); + erts_queue_message(proc, 0, mp, AM_multizero_timeout_in_timeout_done, am_system); + erts_proc_dec_refc(proc); +} + +static void +test_multizero_timeout_in_timeout2(void *vproc) +{ + erts_start_timer_callback(0, test_multizero_timeout_in_timeout3, vproc); +} + +static void +test_multizero_timeout_in_timeout(void *vproc) +{ + erts_start_timer_callback(0, test_multizero_timeout_in_timeout2, vproc); +} + BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) { /* @@ -4513,6 +4557,40 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) erts_set_gc_state(BIF_P, enable); BIF_RET(res); } + else if (ERTS_IS_ATOM_STR("inconsistent_heap", BIF_ARG_1)) { + /* Used by code_SUITE (emulator) */ + if (am_start == BIF_ARG_2) { + Eterm broken_term; + Eterm *hp; + + ERTS_ASSERT(!(BIF_P->flags & F_DISABLE_GC)); + erts_set_gc_state(BIF_P, 0); + + hp = HAlloc(BIF_P, 2); + hp[0] = make_arityval(1234); + hp[1] = THE_NON_VALUE; + + broken_term = make_tuple(hp); + + BIF_RET(broken_term); + } else { + Eterm broken_term; + Eterm *hp; + + broken_term = BIF_ARG_2; + + hp = tuple_val(broken_term); + ERTS_ASSERT(hp[0] == make_arityval(1234)); + ERTS_ASSERT(hp[1] == THE_NON_VALUE); + hp[0] = make_arityval(1); + hp[1] = am_ok; + + ERTS_ASSERT(BIF_P->flags & F_DISABLE_GC); + erts_set_gc_state(BIF_P, 1); + + BIF_RET(am_ok); + } + } else if (ERTS_IS_ATOM_STR("colliding_names", BIF_ARG_1)) { /* Used by ets_SUITE (stdlib) */ if (is_tuple(BIF_ARG_2)) { @@ -4690,6 +4768,18 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) BIF_P->mbuf_sz += sz; BIF_RET(copy); } + else if (ERTS_IS_ATOM_STR("multizero_timeout_in_timeout", BIF_ARG_1)) { + Sint64 timeout; + if (term_to_Sint64(BIF_ARG_2, &timeout)) { + if (timeout < 0) + timeout = 0; + erts_proc_inc_refc(BIF_P); + erts_start_timer_callback((ErtsMonotonicTime) timeout, + test_multizero_timeout_in_timeout, + (void *) BIF_P); + BIF_RET(am_ok); + } + } } BIF_ERROR(BIF_P, BADARG); diff --git a/erts/emulator/beam/erl_bif_lists.c b/erts/emulator/beam/erl_bif_lists.c index aaf262780f..b69949f9cc 100644 --- a/erts/emulator/beam/erl_bif_lists.c +++ b/erts/emulator/beam/erl_bif_lists.c @@ -244,12 +244,25 @@ typedef struct { #define ERTS_RBT_GET_LEFT(T) ((T)->left) #define ERTS_RBT_SET_LEFT(T, L) ((T)->left = (L)) #define ERTS_RBT_GET_KEY(T) ((T)->key) -#define ERTS_RBT_CMP_KEYS(KX, KY) CMP_TERM(KX, KY) +#define ERTS_RBT_CMP_KEYS(KX, KY) subtract_term_cmp((KX), (KY)) #define ERTS_RBT_WANT_LOOKUP_INSERT #define ERTS_RBT_WANT_LOOKUP #define ERTS_RBT_WANT_DELETE #define ERTS_RBT_UNDEF +/* erl_rbtree expects comparisons to return an int */ +static int subtract_term_cmp(Eterm a, Eterm b) { + Sint res = CMP_TERM(a, b); + + if (res < 0) { + return -1; + } else if (res > 0) { + return 1; + } + + return 0; +} + #include "erl_rbtree.h" static int subtract_continue(Process *p, ErtsSubtractContext *context); diff --git a/erts/emulator/beam/erl_bif_persistent.c b/erts/emulator/beam/erl_bif_persistent.c index 5a78a043ce..6115102276 100644 --- a/erts/emulator/beam/erl_bif_persistent.c +++ b/erts/emulator/beam/erl_bif_persistent.c @@ -931,6 +931,7 @@ release_update_permission(int release_updater) erts_resume(updater_process, ERTS_PROC_LOCK_STATUS); } erts_proc_unlock(updater_process, ERTS_PROC_LOCK_STATUS); + erts_proc_dec_refc(updater_process); } updater_process = NULL; @@ -957,6 +958,7 @@ suspend_updater(Process* c_p) ASSERT(updater_process == c_p); erts_mtx_unlock(&update_table_permission_mtx); #endif + erts_proc_inc_refc(c_p); erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL); } @@ -998,3 +1000,102 @@ next_to_delete(void) erts_mtx_unlock(&delete_queue_mtx); return table; } + +/* + * test/debug functionality follow... + */ + +static Uint accessed_literal_areas_size; +static Uint accessed_no_literal_areas; +static ErtsLiteralArea **accessed_literal_areas; + +int +erts_debug_have_accessed_literal_area(ErtsLiteralArea *lap) +{ + Uint i; + for (i = 0; i < accessed_no_literal_areas; i++) { + if (accessed_literal_areas[i] == lap) + return !0; + } + return 0; +} + +void +erts_debug_save_accessed_literal_area(ErtsLiteralArea *lap) +{ + if (accessed_no_literal_areas == accessed_literal_areas_size) { + accessed_literal_areas_size += 10; + accessed_literal_areas = erts_realloc(ERTS_ALC_T_TMP, + accessed_literal_areas, + (sizeof(ErtsLiteralArea *) + *accessed_literal_areas_size)); + } + accessed_literal_areas[accessed_no_literal_areas++] = lap; +} + +static void debug_foreach_off_heap(HashTable *tbl, void (*func)(ErlOffHeap *, void *), void *arg) +{ + int i; + + for (i = 0; i < tbl->allocated; i++) { + Eterm term = tbl->term[i]; + if (is_tuple_arity(term, 2)) { + ErtsLiteralArea *lap = term_to_area(term); + ErlOffHeap oh; + if (!erts_debug_have_accessed_literal_area(lap)) { + ERTS_INIT_OFF_HEAP(&oh); + oh.first = lap->off_heap; + (*func)(&oh, arg); + erts_debug_save_accessed_literal_area(lap); + } + } + } +} + +struct debug_la_oh { + void (*func)(ErlOffHeap *, void *); + void *arg; +}; + +static void debug_handle_table(void *vfap, + ErtsThrPrgrVal val, + void *vtbl) +{ + struct debug_la_oh *fap = vfap; + HashTable *tbl = vtbl; + debug_foreach_off_heap(tbl, fap->func, fap->arg); +} + +void +erts_debug_foreach_persistent_term_off_heap(void (*func)(ErlOffHeap *, void *), void *arg) +{ + HashTable *tbl; + struct debug_la_oh fa; + accessed_no_literal_areas = 0; + accessed_literal_areas_size = 10; + accessed_literal_areas = erts_alloc(ERTS_ALC_T_TMP, + (sizeof(ErtsLiteralArea *) + * accessed_literal_areas_size)); + + tbl = (HashTable *) erts_atomic_read_nob(&the_hash_table); + debug_foreach_off_heap(tbl, func, arg); + erts_mtx_lock(&delete_queue_mtx); + for (tbl = delete_queue_head; tbl; tbl = tbl->delete_next) + debug_foreach_off_heap(tbl, func, arg); + erts_mtx_unlock(&delete_queue_mtx); + fa.func = func; + fa.arg = arg; + erts_debug_later_op_foreach(table_updater, + debug_handle_table, + (void *) &fa); + erts_debug_later_op_foreach(table_deleter, + debug_handle_table, + (void *) &fa); + erts_debug_foreach_release_literal_area_off_heap(func, arg); + + erts_free(ERTS_ALC_T_TMP, accessed_literal_areas); + accessed_no_literal_areas = 0; + accessed_literal_areas_size = 0; + accessed_literal_areas = NULL; +} + diff --git a/erts/emulator/beam/erl_bif_re.c b/erts/emulator/beam/erl_bif_re.c index bbc64eb9aa..8134bd1a3d 100644 --- a/erts/emulator/beam/erl_bif_re.c +++ b/erts/emulator/beam/erl_bif_re.c @@ -1349,31 +1349,69 @@ handle_iolist: rc = erts_pcre_exec(restart.code, &(restart.extra), restart.subject, slength, startoffset, options, restart.ovector, ovsize); - - if (rc == PCRE_ERROR_BADENDIANNESS || rc == PCRE_ERROR_BADMAGIC) { - cleanup_restart_context(&restart); - BIF_ERROR(p,BADARG); + if (rc < 0) { + switch (rc) { + /* No match... */ + case PCRE_ERROR_NOMATCH: + case PCRE_ERROR_MATCHLIMIT: + case PCRE_ERROR_RECURSIONLIMIT: + break; + + /* Yield... */ + case PCRE_ERROR_LOOP_LIMIT: { + /* Trap */ + Binary *mbp = erts_create_magic_binary(sizeof(RestartContext), + cleanup_restart_context_bin); + RestartContext *restartp = ERTS_MAGIC_BIN_DATA(mbp); + Eterm magic_ref; + Eterm *hp; + ASSERT(loop_count != 0xFFFFFFFF); + BUMP_REDS(p, loop_count / LOOP_FACTOR); + sys_memcpy(restartp,&restart,sizeof(RestartContext)); + ERTS_VBUMP_ALL_REDS(p); + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + magic_ref = erts_mk_magic_ref(&hp, &MSO(p), mbp); + BIF_TRAP3(&re_exec_trap_export, + p, + arg1, + arg2 /* To avoid GC of precompiled code, XXX: not utilized yet */, + magic_ref); + } + + /* Recursive loop detected in pattern... */ + case PCRE_ERROR_RECURSELOOP: +#if 1 + loop_count = CONTEXT_REDS*LOOP_FACTOR; /* Unknown amount of work done... */ + break; /* nomatch for backwards compatibility reasons for now... */ +#else + BUMP_ALL_REDS(p); /* Unknown amount of work done... */ + cleanup_restart_context(&restart); + BIF_ERROR(p, BADARG); +#endif + + /* Bad utf8 in subject... */ + case PCRE_ERROR_SHORTUTF8: + case PCRE_ERROR_BADUTF8: + case PCRE_ERROR_BADUTF8_OFFSET: + BUMP_ALL_REDS(p); /* Unknown amount of work done... */ + /* Fall through for badarg... */ + + /* Bad pre-compiled regexp... */ + case PCRE_ERROR_BADMAGIC: + case PCRE_ERROR_BADENDIANNESS: + cleanup_restart_context(&restart); + BIF_ERROR(p, BADARG); + + default: + /* Something unexpected happened... */ + ASSERT(! "Unexpected erts_pcre_exec() result"); + cleanup_restart_context(&restart); + BIF_ERROR(p, EXC_INTERNAL_ERROR); + } } ASSERT(loop_count != 0xFFFFFFFF); BUMP_REDS(p, loop_count / LOOP_FACTOR); - if (rc == PCRE_ERROR_LOOP_LIMIT) { - /* Trap */ - Binary *mbp = erts_create_magic_binary(sizeof(RestartContext), - cleanup_restart_context_bin); - RestartContext *restartp = ERTS_MAGIC_BIN_DATA(mbp); - Eterm magic_ref; - Eterm *hp; - sys_memcpy(restartp,&restart,sizeof(RestartContext)); - BUMP_ALL_REDS(p); - hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); - magic_ref = erts_mk_magic_ref(&hp, &MSO(p), mbp); - BIF_TRAP3(&re_exec_trap_export, - p, - arg1, - arg2 /* To avoid GC of precompiled code, XXX: not utilized yet */, - magic_ref); - } res = build_exec_return(p, rc, &restart, arg1); diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index 711e62c795..b31d5b86cb 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -74,7 +74,7 @@ static void smp_bp_finisher(void* arg); static BIF_RETTYPE system_monitor(Process *p, Eterm monitor_pid, Eterm list); -static void new_seq_trace_token(Process* p); /* help func for seq_trace_2*/ +static void new_seq_trace_token(Process* p, int); /* help func for seq_trace_2*/ static Eterm trace_info_pid(Process* p, Eterm pid_spec, Eterm key); static Eterm trace_info_func(Process* p, Eterm pid_spec, Eterm key); static Eterm trace_info_on_load(Process* p, Eterm key); @@ -1874,7 +1874,7 @@ Eterm erts_seq_trace(Process *p, Eterm arg1, Eterm arg2, if (current_flag && ( (arg2 == am_true) || (arg2 == am_false)) ) { /* Flags */ - new_seq_trace_token(p); + new_seq_trace_token(p, 0); flags = unsigned_val(SEQ_TRACE_TOKEN_FLAGS(p)); if (build_result) { old_value = flags & current_flag ? am_true : am_false; @@ -1889,11 +1889,11 @@ Eterm erts_seq_trace(Process *p, Eterm arg1, Eterm arg2, return old_value; } else if (arg1 == am_label) { - new_seq_trace_token(p); + new_seq_trace_token(p, is_not_immed(arg2)); if (build_result) { old_value = SEQ_TRACE_TOKEN_LABEL(p); } - SEQ_TRACE_TOKEN_LABEL(p) = arg2; + SEQ_TRACE_TOKEN_LABEL(p) = arg2; return old_value; } else if (arg1 == am_serial) { @@ -1905,7 +1905,7 @@ Eterm erts_seq_trace(Process *p, Eterm arg1, Eterm arg2, if ((*tp != make_arityval(2)) || is_not_small(*(tp+1)) || is_not_small(*(tp+2))) { return THE_NON_VALUE; } - new_seq_trace_token(p); + new_seq_trace_token(p, 0); if (build_result) { hp = HAlloc(p,3); old_value = TUPLE2(hp, SEQ_TRACE_TOKEN_LASTCNT(p), @@ -1940,8 +1940,8 @@ Eterm erts_seq_trace(Process *p, Eterm arg1, Eterm arg2, } } -void -new_seq_trace_token(Process* p) +static void +new_seq_trace_token(Process* p, int ensure_new_heap) { Eterm* hp; @@ -1953,6 +1953,16 @@ new_seq_trace_token(Process* p) p->common.id, /* Internal pid */ /* From */ make_small(p->seq_trace_lastcnt)); } + else if (ensure_new_heap) { + Eterm* tpl = tuple_val(SEQ_TRACE_TOKEN(p)); + ASSERT(arityval(tpl[0]) == 5); + if (ErtsInArea(tpl, OLD_HEAP(p), + (OLD_HEND(p) - OLD_HEAP(p))*sizeof(Eterm))) { + hp = HAlloc(p, 6); + sys_memcpy(hp, tpl, 6*sizeof(Eterm)); + SEQ_TRACE_TOKEN(p) = make_tuple(hp); + } + } } BIF_RETTYPE erl_seq_trace_info(Process *p, Eterm item) @@ -2050,10 +2060,7 @@ BIF_RETTYPE seq_trace_print_2(BIF_ALIST_2) if (have_no_seqtrace(SEQ_TRACE_TOKEN(BIF_P))) { BIF_RET(am_false); } - if (!(is_atom(BIF_ARG_1) || is_small(BIF_ARG_1))) { - BIF_ERROR(BIF_P, BADARG); - } - if (SEQ_TRACE_TOKEN_LABEL(BIF_P) != BIF_ARG_1) + if (!EQ(BIF_ARG_1, SEQ_TRACE_TOKEN_LABEL(BIF_P))) BIF_RET(am_false); seq_trace_update_send(BIF_P); seq_trace_output(SEQ_TRACE_TOKEN(BIF_P), BIF_ARG_2, diff --git a/erts/emulator/beam/erl_bif_unique.h b/erts/emulator/beam/erl_bif_unique.h index 944788c67c..f5f07da431 100644 --- a/erts/emulator/beam/erl_bif_unique.h +++ b/erts/emulator/beam/erl_bif_unique.h @@ -297,7 +297,7 @@ erts_iref_storage_save(ErtsIRefStorage *iref, Eterm ref) ASSERT(is_magic_ref_thing(hp)); iref->is_magic = 1; iref->u.mb = mrtp->mb; - erts_refc_inc(&mrtp->mb->intern.refc, 1); + erts_refc_inc(&mrtp->mb->intern.refc, 2); } } @@ -337,7 +337,7 @@ erts_iref_storage_make_ref(ErtsIRefStorage *iref, * refc increment of the cleaned storage... */ if (!clean_storage) - erts_refc_inc(&iref->u.mb->intern.refc, 1); + erts_refc_inc(&iref->u.mb->intern.refc, 2); } #ifdef DEBUG diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index 42d7909a08..dfd532d394 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -1287,12 +1287,18 @@ static int match_traverse(Process* p, DbTableHash* tb, for(;;) { if (*current_ptr != NULL) { if (!is_pseudo_deleted(*current_ptr)) { - match_res = db_match_dbterm(&tb->common, p, mpi.mp, - &(*current_ptr)->dbterm, hpp, 2); + DbTerm* obj = &(*current_ptr)->dbterm; + if (tb->common.compress) + obj = db_alloc_tmp_uncompressed(&tb->common, obj); + match_res = db_match_dbterm_uncompressed(&tb->common, p, mpi.mp, + obj, hpp, 2); saved_current = *current_ptr; if (ctx->on_match_res(ctx, slot_ix, ¤t_ptr, match_res)) { ++got; } + if (tb->common.compress) + db_free_tmp_uncompressed(obj); + --iterations_left; if (*current_ptr != saved_current) { /* Don't advance to next, the callback did it already */ @@ -1406,12 +1412,18 @@ static int match_traverse_continue(Process* p, DbTableHash* tb, for(;;) { if (*current_ptr != NULL) { if (!is_pseudo_deleted(*current_ptr)) { - match_res = db_match_dbterm(&tb->common, p, *mpp, - &(*current_ptr)->dbterm, hpp, 2); + DbTerm* obj = &(*current_ptr)->dbterm; + if (tb->common.compress) + obj = db_alloc_tmp_uncompressed(&tb->common, obj); + match_res = db_match_dbterm_uncompressed(&tb->common, p, *mpp, + obj, hpp, 2); saved_current = *current_ptr; if (ctx->on_match_res(ctx, slot_ix, ¤t_ptr, match_res)) { ++got; } + if (tb->common.compress) + db_free_tmp_uncompressed(obj); + --iterations_left; if (*current_ptr != saved_current) { /* Don't advance to next, the callback did it already */ @@ -3129,16 +3141,19 @@ db_finalize_dbterm_hash(int cret, DbUpdateHandle* handle) } WUNLOCK_HASH(lck); - erts_atomic_dec_nob(&tb->common.nitems); + if (!(handle->flags & DB_INC_TRY_GROW)) + erts_atomic_dec_nob(&tb->common.nitems); try_shrink(tb); } else { if (handle->flags & DB_MUST_RESIZE) { + ASSERT(cret == DB_ERROR_NONE); db_finalize_resize(handle, offsetof(HashDbTerm,dbterm)); free_me = b; } if (handle->flags & DB_INC_TRY_GROW) { int nactive; int nitems = erts_atomic_inc_read_nob(&tb->common.nitems); + ASSERT(cret == DB_ERROR_NONE); WUNLOCK_HASH(lck); nactive = NACTIVE(tb); diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index 8c5fc0acb2..2b68ef9044 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -3404,6 +3404,7 @@ static int doit_select_replace(DbTableTree *tb, TreeDbTerm **this, void *ptr, int forward) { struct select_replace_context *sc = (struct select_replace_context *) ptr; + DbTerm* obj; Eterm ret; sc->lastobj = (*this)->dbterm.tpl; @@ -3414,7 +3415,10 @@ static int doit_select_replace(DbTableTree *tb, TreeDbTerm **this, void *ptr, GETKEY_WITH_POS(sc->keypos, (*this)->dbterm.tpl)) > 0)) { return 0; } - ret = db_match_dbterm(&tb->common, sc->p, sc->mp, &(*this)->dbterm, NULL, 0); + obj = &(*this)->dbterm; + if (tb->common.compress) + obj = db_alloc_tmp_uncompressed(&tb->common, obj); + ret = db_match_dbterm_uncompressed(&tb->common, sc->p, sc->mp, obj, NULL, 0); if (is_value(ret)) { TreeDbTerm* new; @@ -3433,6 +3437,8 @@ static int doit_select_replace(DbTableTree *tb, TreeDbTerm **this, void *ptr, free_term(tb, old); ++(sc->replaced); } + if (tb->common.compress) + db_free_tmp_uncompressed(obj); if (--(sc->max) <= 0) { return 0; } diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index e2c029c244..e0521f7578 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -931,8 +931,6 @@ static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace); static Eterm seq_trace_fake(Process *p, Eterm arg1); -static void db_free_tmp_uncompressed(DbTerm* obj); - /* ** Interface routines. @@ -1975,7 +1973,7 @@ Eterm db_prog_match(Process *c_p, Process *tmpp; Process *current_scheduled; ErtsSchedulerData *esdp; - Eterm (*bif)(Process*, ...); + BIF_RETTYPE (*bif)(BIF_ALIST); Eterm bif_args[3]; int fail_label; #ifdef DMC_DEBUG @@ -2282,8 +2280,8 @@ restart: *esp++ = t; break; case matchCall0: - bif = (Eterm (*)(Process*, ...)) *pc++; - t = (*bif)(build_proc, bif_args); + bif = (BIF_RETTYPE (*)(BIF_ALIST)) *pc++; + t = (*bif)(build_proc, bif_args, NULL); if (is_non_value(t)) { if (do_catch) t = FAIL_TERM; @@ -2293,8 +2291,8 @@ restart: *esp++ = t; break; case matchCall1: - bif = (Eterm (*)(Process*, ...)) *pc++; - t = (*bif)(build_proc, esp-1); + bif = (BIF_RETTYPE (*)(BIF_ALIST)) *pc++; + t = (*bif)(build_proc, esp-1, NULL); if (is_non_value(t)) { if (do_catch) t = FAIL_TERM; @@ -2304,10 +2302,10 @@ restart: esp[-1] = t; break; case matchCall2: - bif = (Eterm (*)(Process*, ...)) *pc++; + bif = (BIF_RETTYPE (*)(BIF_ALIST)) *pc++; bif_args[0] = esp[-1]; bif_args[1] = esp[-2]; - t = (*bif)(build_proc, bif_args); + t = (*bif)(build_proc, bif_args, NULL); if (is_non_value(t)) { if (do_catch) t = FAIL_TERM; @@ -2318,11 +2316,11 @@ restart: esp[-1] = t; break; case matchCall3: - bif = (Eterm (*)(Process*, ...)) *pc++; + bif = (BIF_RETTYPE (*)(BIF_ALIST)) *pc++; bif_args[0] = esp[-1]; bif_args[1] = esp[-2]; bif_args[2] = esp[-3]; - t = (*bif)(build_proc, bif_args); + t = (*bif)(build_proc, bif_args, NULL); if (is_non_value(t)) { if (do_catch) t = FAIL_TERM; @@ -2844,9 +2842,6 @@ Eterm db_add_counter(Eterm** hpp, Wterm counter, Eterm incr) /* Must be called to read elements after db_lookup_dbterm. ** Will decompress if needed. -** HEALFWORD_HEAP: -** Will convert from relative to Wterm format if needed. -** (but only on top level, tuples and lists will still contain rterms) */ Wterm db_do_read_element(DbUpdateHandle* handle, Sint position) { @@ -5330,17 +5325,13 @@ void db_free_tmp_uncompressed(DbTerm* obj) erts_free(ERTS_ALC_T_TMP, obj); } -Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog, - DbTerm* obj, Eterm** hpp, Uint extra) +Eterm db_match_dbterm_uncompressed(DbTableCommon* tb, Process* c_p, Binary* bprog, + DbTerm* obj, Eterm** hpp, Uint extra) { enum erts_pam_run_flags flags; Uint32 dummy; Eterm res; - if (tb->compress) { - obj = db_alloc_tmp_uncompressed(tb, obj); - } - flags = (hpp ? ERTS_PAM_COPY_RESULT | ERTS_PAM_CONTIGUOUS_TUPLE : ERTS_PAM_TMP_RESULT | ERTS_PAM_CONTIGUOUS_TUPLE); @@ -5352,9 +5343,19 @@ Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog, if (is_value(res) && hpp!=NULL) { *hpp = HAlloc(c_p, extra); } + return res; +} +Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog, + DbTerm* obj, Eterm** hpp, Uint extra) +{ + Eterm res; + if (tb->compress) { + obj = db_alloc_tmp_uncompressed(tb, obj); + } + res = db_match_dbterm_uncompressed(tb, c_p, bprog, obj, hpp, extra); if (tb->compress) { - db_free_tmp_uncompressed(obj); + db_free_tmp_uncompressed(obj); } return res; } diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index 6ec3b4f98f..b982a29580 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -306,6 +306,7 @@ Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp, ErlOffHeap* off_heap); int db_eq_comp(DbTableCommon* tb, Eterm a, DbTerm* b); DbTerm* db_alloc_tmp_uncompressed(DbTableCommon* tb, DbTerm* org); +void db_free_tmp_uncompressed(DbTerm* obj); ERTS_GLB_INLINE Eterm db_copy_object_from_ets(DbTableCommon* tb, DbTerm* bp, Eterm** hpp, ErlOffHeap* off_heap); @@ -470,6 +471,8 @@ Binary *db_match_compile(Eterm *matchexpr, Eterm *guards, DMCErrInfo *err_info); /* Returns newly allocated MatchProg binary with refc == 0*/ +Eterm db_match_dbterm_uncompressed(DbTableCommon* tb, Process* c_p, Binary* bprog, + DbTerm* obj, Eterm** hpp, Uint extra); Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog, DbTerm* obj, Eterm** hpp, Uint extra); diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 163724ed3c..94eb3d5e35 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -707,7 +707,7 @@ void erts_usage(void) erts_fprintf(stderr, "-SDPcpu p1:p2 specify dirty CPU schedulers (p1) and dirty CPU schedulers\n"); erts_fprintf(stderr, " online (p2) as percentages of logical processors configured\n"); erts_fprintf(stderr, " and logical processors available, respectively\n"); - erts_fprintf(stderr, "-SDio n set number of dirty I/O schedulers, valid range is [0-%d]\n", + erts_fprintf(stderr, "-SDio n set number of dirty I/O schedulers, valid range is [1-%d]\n", ERTS_MAX_NO_OF_DIRTY_IO_SCHEDULERS); erts_fprintf(stderr, "-t size set the maximum number of atoms the emulator can handle\n"); erts_fprintf(stderr, " valid range is [%d-%d]\n", @@ -1052,7 +1052,7 @@ early_init(int *argc, char **argv) /* } else if (sys_strncmp(type, "io", 2) == 0) { arg = get_arg(argv[i]+5, argv[i+1], &i); dirty_io_scheds = atoi(arg); - if (dirty_io_scheds < 0 || + if (dirty_io_scheds < 1 || dirty_io_scheds > ERTS_MAX_NO_OF_DIRTY_IO_SCHEDULERS) { erts_fprintf(stderr, "bad number of dirty I/O schedulers %s\n", diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 1416c5f96c..730d3f0373 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -127,6 +127,7 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "pollwaiter", "address" }, { "break_waiter_lock", NULL }, #endif /* __WIN32__ */ + { "block_poll_thread", "index" }, { "alcu_init_atoms", NULL }, { "mseg_init_atoms", NULL }, { "mmap_init_atoms", NULL }, diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index a3274d7443..86a2067883 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -895,11 +895,13 @@ erts_move_messages_off_heap(Process *c_p) if (mp->data.attached) continue; + ASSERT(is_immed(ERL_MESSAGE_FROM(mp))); + if (is_immed(ERL_MESSAGE_TERM(mp)) #ifdef USE_VM_PROBES && is_immed(ERL_MESSAGE_DT_UTAG(mp)) #endif - && is_not_immed(ERL_MESSAGE_TOKEN(mp))) + && is_immed(ERL_MESSAGE_TOKEN(mp))) continue; /* diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h index b2550814fd..2ba1f758b9 100644 --- a/erts/emulator/beam/erl_message.h +++ b/erts/emulator/beam/erl_message.h @@ -331,6 +331,8 @@ typedef struct erl_trace_message_queue__ { if ((P)->sig_qs.saved_last) { \ if ((P)->flags & F_DEFERRED_SAVED_LAST) { \ /* Points to middle queue; use end of inner */ \ + /* This is later used by erts_proc_sig_handle_incoming */\ + /* to set the save to the correct place */ \ (P)->sig_qs.save = (P)->sig_qs.last; \ ASSERT(!PEEK_MESSAGE((P))); \ } \ diff --git a/erts/emulator/beam/erl_monitor_link.c b/erts/emulator/beam/erl_monitor_link.c index 48d9bd4ca5..7fc03dd741 100644 --- a/erts/emulator/beam/erl_monitor_link.c +++ b/erts/emulator/beam/erl_monitor_link.c @@ -546,9 +546,10 @@ erts_mon_link_dist_create(Eterm nodename) return mld; } -void -erts_mon_link_dist_destroy__(ErtsMonLnkDist *mld) +static void +mon_link_dist_destroy(void* vmld) { + ErtsMonLnkDist *mld = (ErtsMonLnkDist*)vmld; ERTS_ML_ASSERT(erts_atomic_read_nob(&mld->refc) == 0); ERTS_ML_ASSERT(!mld->alive); ERTS_ML_ASSERT(!mld->links); @@ -559,6 +560,21 @@ erts_mon_link_dist_destroy__(ErtsMonLnkDist *mld) erts_free(ERTS_ALC_T_ML_DIST, mld); } +void +erts_schedule_mon_link_dist_destruction__(ErtsMonLnkDist *mld) +{ + ERTS_ML_ASSERT(erts_atomic_read_nob(&mld->refc) == 0); + ERTS_ML_ASSERT(!mld->alive); + ERTS_ML_ASSERT(!mld->links); + ERTS_ML_ASSERT(!mld->monitors); + ERTS_ML_ASSERT(!mld->orig_name_monitors); + + erts_schedule_thr_prgr_later_cleanup_op(mon_link_dist_destroy, + mld, + &mld->cleanup_lop, + sizeof(ErtsMonLnkDist)); +} + /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ * Monitor Operations * \* */ diff --git a/erts/emulator/beam/erl_monitor_link.h b/erts/emulator/beam/erl_monitor_link.h index ed7bf7d54a..7da8da7638 100644 --- a/erts/emulator/beam/erl_monitor_link.h +++ b/erts/emulator/beam/erl_monitor_link.h @@ -396,6 +396,11 @@ #include "erl_proc_sig_queue.h" #undef ERTS_PROC_SIG_QUEUE_TYPE_ONLY +#define ERL_THR_PROGRESS_TSD_TYPE_ONLY +#include "erl_thr_progress.h" +#undef ERL_THR_PROGRESS_TSD_TYPE_ONLY + + #if defined(DEBUG) || 0 # define ERTS_ML_DEBUG #else @@ -467,7 +472,7 @@ struct ErtsMonLnkNode__ { Uint16 type; }; -typedef struct { +typedef struct ErtsMonLnkDist__ { Eterm nodename; Uint32 connection_id; erts_atomic_t refc; @@ -477,6 +482,7 @@ typedef struct { ErtsMonLnkNode *monitors; /* Monitor double linked circular list */ ErtsMonLnkNode *orig_name_monitors; /* Origin named monitors read-black tree */ + ErtsThrPrgrLaterOp cleanup_lop; } ErtsMonLnkDist; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ @@ -529,7 +535,7 @@ ERTS_GLB_INLINE void erts_ml_dl_list_delete__(ErtsMonLnkNode **list, ErtsMonLnkNode *ml); ERTS_GLB_INLINE ErtsMonLnkNode *erts_ml_dl_list_first__(ErtsMonLnkNode *list); ERTS_GLB_INLINE ErtsMonLnkNode *erts_ml_dl_list_last__(ErtsMonLnkNode *list); -void erts_mon_link_dist_destroy__(ErtsMonLnkDist *mld); +void erts_schedule_mon_link_dist_destruction__(ErtsMonLnkDist *mld); ERTS_GLB_INLINE void *erts_ml_node_to_main_struct__(ErtsMonLnkNode *mln); /* implementations for globally inlined misc functions... */ @@ -547,7 +553,7 @@ erts_mon_link_dist_dec_refc(ErtsMonLnkDist *mld) { ERTS_ML_ASSERT(erts_atomic_read_nob(&mld->refc) > 0); if (erts_atomic_dec_read_nob(&mld->refc) == 0) - erts_mon_link_dist_destroy__(mld); + erts_schedule_mon_link_dist_destruction__(mld); } ERTS_GLB_INLINE void * @@ -1426,14 +1432,14 @@ erts_monitor_dist_insert(ErtsMonitor *mon, ErtsMonLnkDist *dist) ERTS_ML_ASSERT(!mdep->dist); ERTS_ML_ASSERT(dist); - mdep->dist = dist; - - erts_mon_link_dist_inc_refc(dist); erts_mtx_lock(&dist->mtx); insert = dist->alive; if (insert) { + mdep->dist = dist; + erts_mon_link_dist_inc_refc(dist); + if ((mon->flags & (ERTS_ML_FLG_NAME | ERTS_ML_FLG_TARGET)) == ERTS_ML_FLG_NAME) erts_monitor_tree_insert(&dist->orig_name_monitors, mon); @@ -2307,15 +2313,15 @@ erts_link_dist_insert(ErtsLink *lnk, ErtsMonLnkDist *dist) ERTS_ML_ASSERT(!ldep->dist); ERTS_ML_ASSERT(dist); - ldep->dist = dist; - - erts_mon_link_dist_inc_refc(dist); erts_mtx_lock(&dist->mtx); insert = dist->alive; - if (insert) + if (insert) { + ldep->dist = dist; + erts_mon_link_dist_inc_refc(dist); erts_link_list_insert(&dist->links, lnk); + } erts_mtx_unlock(&dist->mtx); diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index 18ed782ae3..8a80ecfa87 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -285,18 +285,16 @@ static ERTS_INLINE DistEntry *find_dist_entry(Eterm sysname, if (connected_only && is_nil(res->cid)) res = NULL; else { - int pend_delete; erts_aint_t refc; if (inc_refc) { refc = de_refc_inc_read(res, 1); - pend_delete = refc < 2; + if (refc < 2) /* Pending delete */ + de_refc_inc(res, 1); } else { - refc = de_refc_read(res, 0); - pend_delete = refc < 1; + /* Inc from 0 to 1 for pending delete */ + erts_refc_inc_if(&ErtsDistEntry2Bin(res)->intern.refc, 0, 0); } - if (pend_delete) /* Pending delete */ - de_refc_inc(res, 1); } } erts_rwmtx_runlock(&erts_dist_table_rwmtx); @@ -396,6 +394,7 @@ erts_build_dhandle(Eterm **hpp, ErlOffHeap* ohp, Eterm mref, dhandle; ASSERT(bin); ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == erts_dist_entry_destructor); + erts_refc_inc_if(&bin->intern.refc, 0, 0); /* inc for pending delete */ mref = erts_mk_magic_ref(hpp, ohp, bin); dhandle = TUPLE2(*hpp, make_small(conn_id), mref); *hpp += 3; @@ -1178,6 +1177,7 @@ static Eterm AM_timer; static Eterm AM_delayed_delete_timer; static Eterm AM_thread_progress_delete_timer; static Eterm AM_signal; +static Eterm AM_persistent_term; static void setup_reference_table(void); static Eterm reference_table_term(Uint **hpp, ErlOffHeap *ohp, Uint *szp); @@ -1272,6 +1272,7 @@ erts_get_node_and_dist_references(struct process *proc) INIT_AM(delayed_delete_timer); INIT_AM(thread_progress_delete_timer); INIT_AM(signal); + INIT_AM(persistent_term); references_atoms_need_init = 0; } @@ -1813,6 +1814,14 @@ insert_sig_link(ErtsLink *lnk, void *arg) } static void +insert_persistent_term(ErlOffHeap *ohp, void *arg) +{ + Eterm heap[3]; + insert_offheap(ohp, SYSTEM_REF, + TUPLE2(&heap[0], AM_system, AM_persistent_term)); +} + +static void setup_reference_table(void) { ErlHeapFragment *hfp; @@ -1911,7 +1920,7 @@ setup_reference_table(void) } } - erts_foreach_sys_msg_in_q(insert_sys_msg); + erts_debug_foreach_sys_msg_in_q(insert_sys_msg); /* Insert all ports */ max = erts_ptab_max(&erts_port); @@ -2008,6 +2017,10 @@ setup_reference_table(void) /* Insert all bif timers */ erts_debug_bif_timer_foreach(insert_bif_timer, NULL); + /* Insert persistent term storage */ + erts_debug_foreach_persistent_term_off_heap(insert_persistent_term, + NULL); + /* Insert node table (references to dist) */ hash_foreach(&erts_node_table, insert_erl_node, NULL); } diff --git a/erts/emulator/beam/erl_proc_sig_queue.c b/erts/emulator/beam/erl_proc_sig_queue.c index 5d7e5ff999..902867f2d3 100644 --- a/erts/emulator/beam/erl_proc_sig_queue.c +++ b/erts/emulator/beam/erl_proc_sig_queue.c @@ -3426,7 +3426,14 @@ stop: { deferred_saved_last = deferred_save = 0; } else { - if (c_p->sig_qs.save == c_p->sig_qs.last) + if (c_p->sig_qs.save == c_p->sig_qs.last && + c_p->sig_qs.save != &c_p->sig_qs.first) + /* When save is set to last AND DEFERRED_SAVED_LAST is + set we know that we have done a ERTS_RECV_MARK_SET + to the last in order to trigger a clean of the middle + queue. However, we cannot know this when there + are no messages in the inner queue, so in that + case we have to parse the entire queue again */ deferred_save = !0; else deferred_save = 0; @@ -3868,6 +3875,7 @@ erts_proc_sig_signal_size(ErtsSignal *sig) case ERTS_MON_TYPE_DIST_PROC: case ERTS_MON_TYPE_NODE: size = erts_monitor_size((ErtsMonitor *) sig); + break; default: ERTS_INTERNAL_ERROR("Unexpected sig type"); break; diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index d0ae08793a..ec7082f8ec 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -181,7 +181,6 @@ sched_get_busy_wait_params(ErtsSchedulerData *esdp) } static ErtsAuxWorkData *aux_thread_aux_work_data; -static ErtsAuxWorkData *poll_thread_aux_work_data; #define ERTS_SCHDLR_SSPND_CHNG_NMSB (((erts_aint32_t) 1) << 0) #define ERTS_SCHDLR_SSPND_CHNG_MSB (((erts_aint32_t) 1) << 1) @@ -410,7 +409,21 @@ typedef union { static ErtsAlignedSchedulerSleepInfo *aligned_sched_sleep_info; static ErtsAlignedSchedulerSleepInfo *aligned_dirty_cpu_sched_sleep_info; static ErtsAlignedSchedulerSleepInfo *aligned_dirty_io_sched_sleep_info; -static ErtsAlignedSchedulerSleepInfo *aligned_poll_thread_sleep_info; + +typedef struct { + erts_mtx_t mtx; + erts_cnd_t cnd; + int blocked; + int id; +} ErtsBlockPollThreadData; + +typedef union { + ErtsBlockPollThreadData block_data; + char align[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsBlockPollThreadData))]; +} ErtsAlignedBlockPollThreadData; + + +static ErtsAlignedBlockPollThreadData *ERTS_WRITE_UNLIKELY(block_poll_thread_data); static Uint last_reductions; static Uint last_exact_reductions; @@ -481,10 +494,6 @@ ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(proclist, 200, ERTS_ALC_T_PROC_LIST) -#define ERTS_POLL_THREAD_SLEEP_INFO_IX(IX) \ - (ASSERT(0 <= ((int) (IX)) \ - && ((int) (IX)) < ((int) erts_no_poll_threads)), \ - &aligned_poll_thread_sleep_info[(IX)].ssi) #define ERTS_SCHED_SLEEP_INFO_IX(IX) \ (ASSERT(((int)-1) <= ((int) (IX)) \ && ((int) (IX)) < ((int) erts_no_schedulers)), \ @@ -1628,6 +1637,11 @@ unset_aux_work_flags(ErtsSchedulerSleepInfo *ssi, erts_aint32_t flgs) return erts_atomic32_read_band_nob(&ssi->aux_work, ~flgs); } +static ERTS_INLINE erts_aint32_t +unset_aux_work_flags_mb(ErtsSchedulerSleepInfo *ssi, erts_aint32_t flgs) +{ + return erts_atomic32_read_band_mb(&ssi->aux_work, ~flgs); +} static ERTS_INLINE void haw_chk_later_cleanup_op_wakeup(ErtsAuxWorkData *awdp, ErtsThrPrgrVal val) @@ -1723,9 +1737,7 @@ handle_delayed_aux_work_wakeup(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, in if (!waiting && awdp->delayed_wakeup.next > awdp->esdp->reductions) return aux_work; - unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_DELAYED_AW_WAKEUP); - - ERTS_THR_MEMORY_BARRIER; + unset_aux_work_flags_mb(awdp->ssi, ERTS_SSI_AUX_WORK_DELAYED_AW_WAKEUP); max_jix = awdp->delayed_wakeup.jix; awdp->delayed_wakeup.jix = -1; @@ -1847,7 +1859,7 @@ handle_misc_aux_work(ErtsAuxWorkData *awdp, { ErtsThrQ_t *q = &misc_aux_work_queues[awdp->sched_id].q; - unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_MISC); + unset_aux_work_flags_mb(awdp->ssi, ERTS_SSI_AUX_WORK_MISC); while (1) { erts_misc_aux_work_t *mawp = erts_thr_q_dequeue(q); if (!mawp) @@ -1949,7 +1961,7 @@ handle_async_ready(ErtsAuxWorkData *awdp, ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); - unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_ASYNC_READY); + unset_aux_work_flags_mb(ssi, ERTS_SSI_AUX_WORK_ASYNC_READY); if (erts_check_async_ready(awdp->async_ready.queue)) { if (set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_ASYNC_READY) & ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN) { @@ -2005,8 +2017,8 @@ handle_fix_alloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting) ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); - unset_aux_work_flags(ssi, (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM - | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC)); + unset_aux_work_flags_mb(ssi, (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM + | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC)); aux_work &= ~(ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC); res = erts_alloc_fix_alloc_shrink(awdp->sched_id, aux_work); @@ -2054,7 +2066,7 @@ handle_delayed_dealloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waitin ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); - unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD); + unset_aux_work_flags_mb(ssi, ERTS_SSI_AUX_WORK_DD); ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_ALLOC); erts_alloc_scheduler_handle_delayed_dealloc((void *) awdp->esdp, &need_thr_progress, @@ -2150,7 +2162,7 @@ handle_canceled_timers(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waitin ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); - unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_CNCLD_TMRS); + unset_aux_work_flags_mb(ssi, ERTS_SSI_AUX_WORK_CNCLD_TMRS); erts_handle_canceled_timers((void *) awdp->esdp, &need_thr_progress, &wakeup, @@ -2320,7 +2332,7 @@ handle_debug_wait_completed(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int w awdp->debug.wait_completed.callback = NULL; awdp->debug.wait_completed.arg = NULL; - unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED); + unset_aux_work_flags_mb(ssi, ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED); return aux_work & ~ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED; } @@ -2444,7 +2456,7 @@ int erts_halt_code; static ERTS_INLINE erts_aint32_t handle_reap_ports(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting) { - unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_REAP_PORTS); + unset_aux_work_flags_mb(awdp->ssi, ERTS_SSI_AUX_WORK_REAP_PORTS); ERTS_RUNQ_FLGS_SET(awdp->esdp->run_queue, ERTS_RUNQ_FLG_HALTING); if (erts_atomic32_dec_read_acqb(&erts_halt_progress) == 0) { @@ -2539,7 +2551,7 @@ handle_yield(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting) static ERTS_INLINE erts_aint32_t handle_mseg_cache_check(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting) { - unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK); + unset_aux_work_flags_mb(awdp->ssi, ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK); erts_mseg_cache_check(); return aux_work & ~ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK; } @@ -2550,7 +2562,7 @@ handle_mseg_cache_check(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiti static ERTS_INLINE erts_aint32_t handle_setup_aux_work_timer(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting) { - unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_SET_TMO); + unset_aux_work_flags_mb(awdp->ssi, ERTS_SSI_AUX_WORK_SET_TMO); setup_aux_work_timer(awdp->esdp); return aux_work & ~ERTS_SSI_AUX_WORK_SET_TMO; } @@ -2989,8 +3001,10 @@ sched_set_sleeptype(ErtsSchedulerSleepInfo *ssi, erts_aint32_t sleep_type) erts_aint32_t nflgs = ERTS_SSI_FLG_SLEEPING|ERTS_SSI_FLG_WAITING|sleep_type; erts_aint32_t xflgs = ERTS_SSI_FLG_SLEEPING|ERTS_SSI_FLG_WAITING; - if (sleep_type == ERTS_SSI_FLG_TSE_SLEEPING) + if (sleep_type == ERTS_SSI_FLG_TSE_SLEEPING) { + erts_tse_use(ssi->event); erts_tse_reset(ssi->event); + } else { ASSERT(sleep_type == ERTS_SSI_FLG_POLL_SLEEPING); erts_check_io_interrupt(ssi->psi, 0); @@ -3034,6 +3048,7 @@ thr_prgr_wait(void *vssi) ErtsSchedulerSleepInfo *ssi = (ErtsSchedulerSleepInfo *) vssi; erts_aint32_t xflgs = ERTS_SSI_FLG_SLEEPING; + erts_tse_use(ssi->event); erts_tse_reset(ssi->event); while (1) { @@ -3048,6 +3063,7 @@ thr_prgr_wait(void *vssi) break; xflgs = aflgs; } + erts_tse_return(ssi->event); } static void @@ -3087,6 +3103,7 @@ aux_thread(void *unused) erts_port_task_pre_alloc_init_thread(); ssi->event = erts_tse_fetch(); + erts_tse_return(ssi->event); erts_msacc_init_thread("aux", 1, 1); @@ -3096,7 +3113,7 @@ aux_thread(void *unused) callbacks.wait = thr_prgr_wait; callbacks.finalize_wait = thr_prgr_fin_wait; - tpd = erts_thr_progress_register_managed_thread(NULL, &callbacks, 1); + tpd = erts_thr_progress_register_managed_thread(NULL, &callbacks, 1, 0); init_aux_work_data(awdp, NULL, NULL); awdp->ssi = ssi; @@ -3145,7 +3162,7 @@ aux_thread(void *unused) if (flgs & ERTS_SSI_FLG_SLEEPING) { ASSERT(flgs & ERTS_SSI_FLG_POLL_SLEEPING); ASSERT(flgs & ERTS_SSI_FLG_WAITING); - erts_check_io(ssi->psi, ERTS_POLL_INF_TIMEOUT); + erts_check_io(ssi->psi, ERTS_POLL_INF_TIMEOUT, 0); } } #else @@ -3165,6 +3182,7 @@ aux_thread(void *unused) } while (res == EINTR); ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_OTHER); } + erts_tse_return(ssi->event); } erts_thr_progress_finalize_wait(tpd); #endif @@ -3175,15 +3193,46 @@ aux_thread(void *unused) return NULL; } +static void +pt_wake(void *vbpt) +{ + ErtsBlockPollThreadData *bpt = (ErtsBlockPollThreadData *) vbpt; + erts_mtx_lock(&bpt->mtx); + bpt->blocked = 0; + erts_cnd_signal(&bpt->cnd); + erts_mtx_unlock(&bpt->mtx); +} + +static void +pt_wait(void *vbpt) +{ + ErtsBlockPollThreadData *bpt = (ErtsBlockPollThreadData *) vbpt; + erts_mtx_lock(&bpt->mtx); + while (bpt->blocked) + erts_cnd_wait(&bpt->cnd, &bpt->mtx); + erts_mtx_unlock(&bpt->mtx); +} + +static void +pt_prep_wait(void *vbpt) +{ + ErtsBlockPollThreadData *bpt = (ErtsBlockPollThreadData *) vbpt; + erts_mtx_lock(&bpt->mtx); + bpt->blocked = !0; + erts_mtx_unlock(&bpt->mtx); +} + +static void +pt_fin_wait(void *vbpt) +{ + +} + static void * -poll_thread(void *arg) +poll_thread(void *vbpt) { - int id = (int)(UWord)arg; - ErtsAuxWorkData *awdp = poll_thread_aux_work_data+id; - ErtsSchedulerSleepInfo *ssi = ERTS_POLL_THREAD_SLEEP_INFO_IX(id); - erts_aint32_t aux_work; + ErtsBlockPollThreadData *bpt = (ErtsBlockPollThreadData *) vbpt; ErtsThrPrgrCallbacks callbacks; - int thr_prgr_active = 1; struct erts_poll_thread *psi; ErtsThrPrgrData *tpd; ERTS_MSACC_DECLARE_CACHE(); @@ -3196,59 +3245,24 @@ poll_thread(void *arg) #endif erts_port_task_pre_alloc_init_thread(); - ssi->event = erts_tse_fetch(); - - erts_msacc_init_thread("poll", id, 0); - - callbacks.arg = (void *) ssi; - callbacks.wakeup = thr_prgr_wakeup; - callbacks.prepare_wait = thr_prgr_prep_wait; - callbacks.wait = thr_prgr_wait; - callbacks.finalize_wait = thr_prgr_fin_wait; - tpd = erts_thr_progress_register_managed_thread(NULL, &callbacks, 0); - init_aux_work_data(awdp, NULL, NULL); - awdp->ssi = ssi; + erts_msacc_init_thread("poll", bpt->id, 0); - psi = erts_create_pollset_thread(id, tpd); + callbacks.arg = vbpt; + callbacks.wakeup = pt_wake; + callbacks.prepare_wait = pt_prep_wait; + callbacks.wait = pt_wait; + callbacks.finalize_wait = pt_fin_wait; - ssi->psi = psi; + tpd = erts_thr_progress_register_managed_thread(NULL, &callbacks, 0, !0); - sched_prep_spin_wait(ssi); + psi = erts_create_pollset_thread(bpt->id, tpd); ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_OTHER); while (1) { - erts_aint32_t flgs; - - aux_work = erts_atomic32_read_acqb(&ssi->aux_work); - if (aux_work) { - if (!thr_prgr_active) - erts_thr_progress_active(tpd, thr_prgr_active = 1); - aux_work = handle_aux_work(awdp, aux_work, 1); - ERTS_MSACC_UPDATE_CACHE(); - if (aux_work && erts_thr_progress_update(tpd)) - erts_thr_progress_leader_update(tpd); - } - - if (!aux_work) { - if (thr_prgr_active) - erts_thr_progress_active(tpd, thr_prgr_active = 0); - - flgs = sched_spin_wait(ssi, 0); - - if (flgs & ERTS_SSI_FLG_SLEEPING) { - ASSERT(flgs & ERTS_SSI_FLG_WAITING); - flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_POLL_SLEEPING); - if (flgs & ERTS_SSI_FLG_SLEEPING) { - ASSERT(flgs & ERTS_SSI_FLG_POLL_SLEEPING); - ASSERT(flgs & ERTS_SSI_FLG_WAITING); - erts_check_io(psi, ERTS_POLL_INF_TIMEOUT); - } - } - } - - flgs = sched_prep_spin_wait(ssi); + erts_check_io_interrupt(psi, 0); + erts_check_io(psi, ERTS_POLL_INF_TIMEOUT, !0); } return NULL; } @@ -3433,7 +3447,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) if (flgs & ERTS_SSI_FLG_SLEEPING) { ASSERT(flgs & ERTS_SSI_FLG_POLL_SLEEPING); ASSERT(flgs & ERTS_SSI_FLG_WAITING); - erts_check_io(ssi->psi, timeout_time); + erts_check_io(ssi->psi, timeout_time, 0); current_time = erts_get_monotonic_time(esdp); } } @@ -3474,6 +3488,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) erts_get_monotonic_time(esdp); } while (res == EINTR); } + erts_tse_return(ssi->event); } if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) erts_thr_progress_finalize_wait(erts_thr_prgr_data(esdp)); @@ -6023,18 +6038,6 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online, int no_poll_th erts_atomic32_init_nob(&ssi->aux_work, 0); } - aligned_poll_thread_sleep_info = - erts_alloc_permanent_cache_aligned( - ERTS_ALC_T_SCHDLR_SLP_INFO, - no_poll_threads*sizeof(ErtsAlignedSchedulerSleepInfo)); - for (ix = 0; ix < no_poll_threads; ix++) { - ErtsSchedulerSleepInfo *ssi = &aligned_poll_thread_sleep_info[ix].ssi; - ssi->esdp = NULL; - erts_atomic32_init_nob(&ssi->flags, 0); - ssi->event = NULL; /* initialized in poll_thread */ - erts_atomic32_init_nob(&ssi->aux_work, 0); - } - /* Create and initialize scheduler specific data */ daww_sz = ERTS_ALC_CACHE_LINE_ALIGN_SIZE((sizeof(ErtsDelayedAuxWorkWakeupJob) @@ -6095,10 +6098,6 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online, int no_poll_th erts_alloc_permanent_cache_aligned(ERTS_ALC_T_SCHDLR_DATA, sizeof(ErtsAuxWorkData)); - poll_thread_aux_work_data = - erts_alloc_permanent_cache_aligned(ERTS_ALC_T_SCHDLR_DATA, - no_poll_threads * sizeof(ErtsAuxWorkData)); - init_no_runqs(no_schedulers_online, no_schedulers_online); balance_info.last_active_runqs = no_schedulers; erts_mtx_init(&balance_info.update_mtx, "migration_info_update", NIL, @@ -6923,13 +6922,25 @@ schedule_process_sys_task(Process *p, erts_aint32_t prio, ErtsProcSysTask *st, { erts_aint32_t fail_state, state; + fail_state = *fail_state_p; + /* Elevate priority if needed. */ - state = erts_atomic32_read_nob(&p->state); - if (ERTS_PSFLGS_GET_ACT_PRIO(state) > prio) { + state = erts_atomic32_read_acqb(&p->state); + if (ERTS_PSFLGS_GET_ACT_PRIO(state) <= prio) { + if (state & fail_state) { + *fail_state_p = state & fail_state; + return 0; + } + } + else { erts_aint32_t n, a, e; a = state; do { + if (a & fail_state) { + *fail_state_p = a & fail_state; + return 0; + } if (ERTS_PSFLGS_GET_ACT_PRIO(a) <= prio) { n = a; break; @@ -6943,8 +6954,6 @@ schedule_process_sys_task(Process *p, erts_aint32_t prio, ErtsProcSysTask *st, state = n; } - fail_state = *fail_state_p; - return !(active_sys_enqueue(p, st, prio, ERTS_PSFLG_SYS_TASKS, state, fail_state_p) & fail_state); } @@ -7138,6 +7147,7 @@ sched_set_suspended_sleeptype(ErtsSchedulerSleepInfo *ssi, | ERTS_SSI_FLG_SUSPENDED); ASSERT(sleep_type == ERTS_SSI_FLG_TSE_SLEEPING); + erts_tse_use(ssi->event); erts_tse_reset(ssi->event); while (1) { @@ -7464,11 +7474,16 @@ msb_scheduler_type_switch(ErtsSchedType sched_type, } static ERTS_INLINE void -suspend_normal_scheduler_sleep(ErtsSchedulerData *esdp) +suspend_scheduler_sleep(ErtsSchedulerData *esdp, + int normal_sched, + ErtsMonotonicTime initial_time, + ErtsMonotonicTime timeout_time) { ErtsSchedulerSleepInfo *ssi = esdp->ssi; erts_aint32_t flgs = sched_spin_suspended(ssi, ERTS_SCHED_SUSPEND_SLEEP_SPINCOUNT); + ASSERT(!normal_sched || esdp->type == ERTS_SCHED_NORMAL); + ASSERT(esdp->type != ERTS_SCHED_NORMAL || normal_sched); if (flgs == (ERTS_SSI_FLG_SLEEPING | ERTS_SSI_FLG_WAITING | ERTS_SSI_FLG_SUSPENDED)) { @@ -7477,21 +7492,35 @@ suspend_normal_scheduler_sleep(ErtsSchedulerData *esdp) | ERTS_SSI_FLG_TSE_SLEEPING | ERTS_SSI_FLG_WAITING | ERTS_SSI_FLG_SUSPENDED)) { - int res; + if (!normal_sched) { + while (1) { + int res = erts_tse_wait(ssi->event); + if (res != EINTR) + break; + } + } + else { + ErtsMonotonicTime current_time = initial_time; + while (1) { + int res; + Sint64 timeout; - do { - res = erts_tse_wait(ssi->event); - } while (res == EINTR); + timeout = ERTS_MONOTONIC_TO_NSEC(timeout_time + - current_time + - 1) + 1; + res = erts_tse_twait(ssi->event, timeout); + if (res != EINTR) + break; + current_time = erts_get_monotonic_time(esdp); + if (current_time >= timeout_time) + break; + } + } } + erts_tse_return(ssi->event); } } -static ERTS_INLINE void -suspend_dirty_scheduler_sleep(ErtsSchedulerData *esdp) -{ - suspend_normal_scheduler_sleep(esdp); -} - static void suspend_scheduler(ErtsSchedulerData *esdp) { @@ -7592,18 +7621,31 @@ suspend_scheduler(ErtsSchedulerData *esdp) for (i = 0; msb[i]; i++) { erts_aint32_t clr_flg = 0; - if (msb[i] == &schdlr_sspnd.nmsb - && schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, - ERTS_SCHED_NORMAL) == 1) { - clr_flg = ERTS_SCHDLR_SSPND_CHNG_NMSB; + if (!msb[i]->ongoing) + continue; + + if (msb[i] == &schdlr_sspnd.nmsb) { + if (schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_NORMAL) == 1) { + clr_flg = ERTS_SCHDLR_SSPND_CHNG_NMSB; + } } - else if (schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, - ERTS_SCHED_NORMAL) == 1 - && schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, - ERTS_SCHED_DIRTY_CPU) == 0 - && schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, - ERTS_SCHED_DIRTY_IO) == 0) { - clr_flg = ERTS_SCHDLR_SSPND_CHNG_MSB; + else { + ASSERT(msb[i] == &schdlr_sspnd.msb); + if (schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_NORMAL) == 1 + && schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_DIRTY_CPU) == 0 + && schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_DIRTY_IO) == 0) { + + clr_flg = ERTS_SCHDLR_SSPND_CHNG_MSB; + + /* Begin switching between scheduler types executing... */ + ERTS_RUNQ_FLGS_SET_NOB(ERTS_RUNQ_IX(0), ERTS_RUNQ_FLG_MSB_EXEC); + erts_atomic32_read_bor_nob(&ERTS_RUNQ_IX(0)->scheduler->ssi->flags, + ERTS_SSI_FLG_MSB_EXEC); + } } if (clr_flg) { @@ -7686,7 +7728,7 @@ suspend_scheduler(ErtsSchedulerData *esdp) while (1) { if (sched_type != ERTS_SCHED_NORMAL) - suspend_dirty_scheduler_sleep(esdp); + suspend_scheduler_sleep(esdp, 0, 0, 0); else { ErtsMonotonicTime current_time, timeout_time; @@ -7731,7 +7773,7 @@ suspend_scheduler(ErtsSchedulerData *esdp) sched_wall_time_change(esdp, 0); } erts_thr_progress_prepare_wait(erts_thr_prgr_data(NULL)); - suspend_normal_scheduler_sleep(esdp); + suspend_scheduler_sleep(esdp, !0, current_time, timeout_time); erts_thr_progress_finalize_wait(erts_thr_prgr_data(NULL)); current_time = erts_get_monotonic_time(esdp); } @@ -8236,9 +8278,6 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal } if (!normal) { - ERTS_RUNQ_FLGS_SET_NOB(ERTS_RUNQ_IX(0), ERTS_RUNQ_FLG_MSB_EXEC); - erts_atomic32_read_bor_nob(&ERTS_RUNQ_IX(0)->scheduler->ssi->flags, - ERTS_SSI_FLG_MSB_EXEC); for (ix = 0; ix < erts_no_dirty_cpu_schedulers; ix++) dcpu_sched_ix_suspend_wake(ix); for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) @@ -8421,6 +8460,7 @@ sched_thread_func(void *vesdp) tse = erts_tse_fetch(); erts_tse_prepare_timed(tse); ERTS_SCHED_SLEEP_INFO_IX(no - 1)->event = tse; + erts_tse_return(tse); callbacks.arg = (void *) esdp->ssi; callbacks.wakeup = thr_prgr_wakeup; callbacks.prepare_wait = thr_prgr_prep_wait; @@ -8429,7 +8469,7 @@ sched_thread_func(void *vesdp) erts_msacc_init_thread("scheduler", no, 1); - erts_thr_progress_register_managed_thread(esdp, &callbacks, 0); + erts_thr_progress_register_managed_thread(esdp, &callbacks, 0, 0); #if ERTS_POLL_USE_SCHEDULER_POLLING esdp->ssi->psi = erts_create_pollset_thread(-1, NULL); @@ -8485,6 +8525,7 @@ sched_dirty_cpu_thread_func(void *vesdp) Uint no = esdp->dirty_no; ASSERT(no != 0); ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(no-1)->event = erts_tse_fetch(); + erts_tse_return(ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(no-1)->event); callbacks.arg = (void *) esdp->ssi; callbacks.wakeup = thr_prgr_wakeup; callbacks.prepare_wait = NULL; @@ -8531,6 +8572,7 @@ sched_dirty_io_thread_func(void *vesdp) Uint no = esdp->dirty_no; ASSERT(no != 0); ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(no-1)->event = erts_tse_fetch(); + erts_tse_return(ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(no-1)->event); callbacks.arg = (void *) esdp->ssi; callbacks.wakeup = thr_prgr_wakeup; callbacks.prepare_wait = NULL; @@ -8652,10 +8694,25 @@ erts_start_schedulers(void) if (res != 0) erts_exit(ERTS_ERROR_EXIT, "Failed to create aux thread, error = %d\n", res); + block_poll_thread_data = (ErtsAlignedBlockPollThreadData *) + erts_alloc_permanent_cache_aligned(ERTS_ALC_T_BLOCK_PTHR_DATA, + sizeof(ErtsAlignedBlockPollThreadData) + * erts_no_poll_threads); + + for (ix = 0; ix < erts_no_poll_threads; ix++) { + ErtsBlockPollThreadData *bpt = &block_poll_thread_data[ix].block_data; + erts_mtx_init(&bpt->mtx, "block_poll_thread", + make_small(ix), + (ERTS_LOCK_FLAGS_PROPERTY_STATIC + | ERTS_LOCK_FLAGS_CATEGORY_IO)); + erts_cnd_init(&bpt->cnd); + bpt->blocked = 0; + bpt->id = ix; + erts_snprintf(opts.name, 16, "%d_poller", ix); - res = ethr_thr_create(&tid, poll_thread, (void*)(UWord)ix, &opts); + res = ethr_thr_create(&tid, poll_thread, (void*) bpt, &opts); if (res != 0) erts_exit(ERTS_ERROR_EXIT, "Failed to create poll thread\n"); } @@ -8694,6 +8751,9 @@ erts_internal_suspend_process_2(BIF_ALIST_2) if (BIF_P->common.id == BIF_ARG_1) BIF_RET(am_badarg); /* We are not allowed to suspend ourselves */ + if (!is_internal_pid(BIF_ARG_1)) + BIF_RET(am_badarg); + if (is_not_nil(BIF_ARG_2)) { /* Parse option list */ Eterm arg = BIF_ARG_2; @@ -8842,6 +8902,9 @@ resume_process_1(BIF_ALIST_1) if (BIF_P->common.id == BIF_ARG_1) BIF_ERROR(BIF_P, BADARG); + if (!is_internal_pid(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + mon = erts_monitor_tree_lookup(ERTS_P_MONITORS(BIF_P), BIF_ARG_1); if (!mon) { @@ -9554,7 +9617,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO); LTTNG2(scheduler_poll, esdp->no, 1); - erts_check_io(esdp->ssi->psi, ERTS_POLL_NO_TIMEOUT); + erts_check_io(esdp->ssi->psi, ERTS_POLL_NO_TIMEOUT, 0); ERTS_MSACC_POP_STATE_M(); current_time = erts_get_monotonic_time(esdp); @@ -9622,6 +9685,24 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) ASSERT(p); /* Wrong qmask in rq->flags? */ +#ifdef DEBUG + switch (((erts_aint32_t) 1) << ERTS_PSFLGS_GET_PRQ_PRIO(state)) { + case MAX_BIT: + ASSERT(qbit == MAX_BIT); + break; + case HIGH_BIT: + ASSERT(qbit == HIGH_BIT); + break; + case NORMAL_BIT: + case LOW_BIT: + ASSERT(qbit == NORMAL_BIT || qbit == LOW_BIT); + break; + default: + ASSERT(0); + break; + } +#endif + if (is_normal_sched) { psflg_running = ERTS_PSFLG_RUNNING; psflg_running_sys = ERTS_PSFLG_RUNNING_SYS; @@ -9632,6 +9713,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) psflg_running = ERTS_PSFLG_DIRTY_RUNNING; psflg_running_sys = ERTS_PSFLG_DIRTY_RUNNING_SYS; psflg_band_mask = ~((erts_aint32_t) 0); + qbit = ((erts_aint32_t) 1) << ERTS_PSFLGS_GET_PRQ_PRIO(state); } if (!(state & ERTS_PSFLG_PROXY)) @@ -10106,10 +10188,14 @@ fetch_sys_task(Process *c_p, erts_aint32_t state, int *qmaskp, int *priop) qmask = c_p->sys_task_qs->qmask; - if ((state & (ERTS_PSFLG_ACTIVE + if ((state & (ERTS_PSFLGS_DIRTY_WORK + | ERTS_PSFLG_ACTIVE | ERTS_PSFLG_EXITING | ERTS_PSFLG_SUSPENDED)) == ERTS_PSFLG_ACTIVE) { - /* No sys tasks if we got exclusively higher prio user work to do */ + /* + * No sys tasks if we got exclusively higher prio user work + * to do; ignoring dirty work... + */ st = NULL; switch (ERTS_PSFLGS_GET_USR_PRIO(state)) { case PRIORITY_MAX: @@ -10136,13 +10222,14 @@ fetch_sys_task(Process *c_p, erts_aint32_t state, int *qmaskp, int *priop) *priop = PRIORITY_HIGH; break; case NORMAL_BIT: - if (!(qmask & PRIORITY_LOW) + if (!(qmask & LOW_BIT) || ++c_p->sys_task_qs->ncount <= RESCHEDULE_LOW) { qp = &c_p->sys_task_qs->q[PRIORITY_NORMAL]; *priop = PRIORITY_NORMAL; break; } c_p->sys_task_qs->ncount = 0; + qbit = LOW_BIT; /* Fall through */ case LOW_BIT: qp = &c_p->sys_task_qs->q[PRIORITY_LOW]; @@ -10660,7 +10747,7 @@ request_system_task(Process *c_p, Eterm requester, Eterm target, Eterm priority_req, Eterm operation) { BIF_RETTYPE ret; - Process *rp = erts_proc_lookup(target); + Process *rp = erts_proc_lookup_raw(target); ErtsProcSysTask *st = NULL; erts_aint32_t prio, fail_state = ERTS_PSFLG_EXITING; Eterm noproc_res, req_type, priority = priority_req; @@ -10795,6 +10882,7 @@ request_system_task(Process *c_p, Eterm requester, Eterm target, goto badarg; st->type = ERTS_PSTT_CLA; noproc_res = am_ok; + fail_state = ERTS_PSFLG_FREE; if (!rp) goto noproc; break; @@ -10839,7 +10927,7 @@ request_system_task(Process *c_p, Eterm requester, Eterm target, */ } if (!schedule_process_sys_task(rp, prio, st, &fail_state)) { - if (fail_state & ERTS_PSFLG_EXITING) { + if (fail_state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_FREE)) { noproc: notify_sys_task_executed(c_p, st, noproc_res, 1); } @@ -11213,7 +11301,7 @@ erts_set_gc_state(Process *c_p, int enable) first1 = dgc_tsk_qs->q[prio]; last1 = first1->prev; first2 = stsk_qs->q[prio]; - last2 = first1->prev; + last2 = first2->prev; last1->next = first2; first2->prev = last1; @@ -12071,6 +12159,7 @@ delete_process(Process* p) ErtsPSD *psd; struct saved_calls *scb; process_breakpoint_time_t *pbt; + Uint32 block_rla_ref = (Uint32) (Uint) p->u.terminate; VERBOSE(DEBUG_PROCESSES, ("Removing process: %T\n",p->common.id)); VERBOSE(DEBUG_SHCOPY, ("[pid=%T] delete process: %p %p %p %p\n", p->common.id, @@ -12141,6 +12230,9 @@ delete_process(Process* p) p->sig_qs.cont = NULL; p->fvalue = NIL; + + if (block_rla_ref) + erts_unblock_release_literal_area(block_rla_ref); } static ERTS_INLINE void @@ -12536,6 +12628,7 @@ erts_continue_exit_process(Process *p) } ASSERT(erts_proc_read_refc(p) > 0); p->bif_timers = NULL; + ASSERT(!p->u.terminate); } if (p->flags & F_SCHDLR_ONLN_WAITQ) @@ -12560,7 +12653,9 @@ erts_continue_exit_process(Process *p) erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error: %d\n", __FILE__, __LINE__, (int) ssr); } + ASSERT(!p->u.terminate); } + if (p->flags & F_HAVE_BLCKD_NMSCHED) { ErtsSchedSuspendResult ssr; ssr = erts_block_multi_scheduling(p, ERTS_PROC_LOCK_MAIN, 0, 1, 1); @@ -12580,16 +12675,40 @@ erts_continue_exit_process(Process *p) erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error: %d\n", __FILE__, __LINE__, (int) ssr); } + ASSERT(!p->u.terminate); } if (p->flags & F_USING_DB) { if (erts_db_process_exiting(p, ERTS_PROC_LOCK_MAIN)) goto yield; p->flags &= ~F_USING_DB; + ASSERT(!p->u.terminate); } - erts_set_gc_state(p, 1); state = erts_atomic32_read_acqb(&p->state); + /* + * If we might access any literals on the heap after this point, + * we need to block release of literal areas. After this point, + * since cleanup of sys-tasks reply to copy-literals requests. + * Note that we do not only have to prevent release of + * currently processed literal area, but also future processed + * literal areas, until we are guaranteed not to access any + * literal areas at all. + * + * - A non-immediate exit reason may refer to literals. + * - A process executing dirty while terminated, might access + * any term on the heap, and therfore literals, until it has + * stopped executing dirty. + */ + if (!p->u.terminate + && (is_not_immed(reason) + || (state & (ERTS_PSFLG_DIRTY_RUNNING + | ERTS_PSFLG_DIRTY_RUNNING_SYS)))) { + Uint32 block_rla_ref = erts_block_release_literal_area(); + p->u.terminate = (void *) (Uint) block_rla_ref; + } + + erts_set_gc_state(p, 1); if ((state & ERTS_PSFLG_SYS_TASKS) || p->dirty_sys_tasks) { if (cleanup_sys_tasks(p, state, CONTEXT_REDS) >= CONTEXT_REDS/2) goto yield; @@ -12681,8 +12800,10 @@ erts_continue_exit_process(Process *p) refc_inced = 1; } a = erts_atomic32_cmpxchg_mb(&p->state, n, e); - if (a == e) + if (a == e) { + state = n; break; + } } if (a & (ERTS_PSFLG_DIRTY_RUNNING @@ -12703,12 +12824,11 @@ erts_continue_exit_process(Process *p) ? ERTS_PROC_SET_DIST_ENTRY(p, NULL) : NULL); - /* - * It might show up signal prio elevation tasks until we - * have entered free state. Cleanup such tasks now. + * It might show up copy-literals and signal prio + * elevation tasks until we have entered free + * state. Cleanup such tasks now. */ - state = erts_atomic32_read_acqb(&p->state); if (!(state & ERTS_PSFLG_SYS_TASKS)) erts_proc_unlock(p, ERTS_PROC_LOCKS_ALL); else { diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 43937f216c..e1d899afd9 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -1226,9 +1226,10 @@ void erts_check_for_holes(Process* p); /* The sequential tracing token is a tuple of size 5: * - * {Flags, Label, Serial, Sender} + * {Flags, Label, Serial, Sender, LastCnt} + * + * WARNING: The top 5-tuple is *MUTABLE* and thus INTERNAL ONLY. */ - #define SEQ_TRACE_TOKEN_ARITY(p) (arityval(*(tuple_val(SEQ_TRACE_TOKEN(p))))) #define SEQ_TRACE_TOKEN_FLAGS(p) (*(tuple_val(SEQ_TRACE_TOKEN(p)) + 1)) #define SEQ_TRACE_TOKEN_LABEL(p) (*(tuple_val(SEQ_TRACE_TOKEN(p)) + 2)) @@ -2346,6 +2347,8 @@ erts_try_change_runq_proc(Process *p, ErtsRunQueue *rq) old_rqint); if (act_rqint == old_rqint) return !0; + + old_rqint = act_rqint; } } diff --git a/erts/emulator/beam/erl_thr_progress.c b/erts/emulator/beam/erl_thr_progress.c index bac437efe9..980a54ffe2 100644 --- a/erts/emulator/beam/erl_thr_progress.c +++ b/erts/emulator/beam/erl_thr_progress.c @@ -558,7 +558,8 @@ erts_thr_progress_register_unmanaged_thread(ErtsThrPrgrCallbacks *callbacks) ErtsThrPrgrData * erts_thr_progress_register_managed_thread(ErtsSchedulerData *esdp, ErtsThrPrgrCallbacks *callbacks, - int pref_wakeup) + int pref_wakeup, + int deep_sleeper) { ErtsThrPrgrData *tpd = perhaps_thr_prgr_data(NULL); int is_blocking = 0, managed; @@ -593,6 +594,7 @@ erts_thr_progress_register_managed_thread(ErtsSchedulerData *esdp, tpd->is_managed = 1; tpd->is_blocking = is_blocking; tpd->is_temporary = 0; + tpd->is_deep_sleeper = deep_sleeper; #ifdef ERTS_ENABLE_LOCK_CHECK tpd->is_delaying = 1; #endif @@ -888,7 +890,10 @@ erts_thr_progress_prepare_wait(ErtsThrPrgrData *tpd) == ERTS_THR_PRGR_LFLG_NO_LEADER && got_sched_wakeups()) { /* Someone need to make progress */ - wakeup_managed(tpd->id); + if (tpd->is_deep_sleeper) + wakeup_managed(1); + else + wakeup_managed(tpd->id); } } @@ -1072,11 +1077,13 @@ request_wakeup_managed(ErtsThrPrgrData *tpd, ErtsThrPrgrVal value) /* * Only managed threads that aren't in waiting state - * are allowed to call this function. + * and aren't deep sleepers are allowed to call this + * function. */ ASSERT(tpd->is_managed); ASSERT(tpd->confirmed != ERTS_THR_PRGR_VAL_WAITING); + ASSERT(!tpd->is_deep_sleeper); if (has_reached_wakeup(value)) { wakeup_managed(tpd->id); @@ -1345,6 +1352,8 @@ thr_progress_block(ErtsThrPrgrData *tpd, int wait) bc = erts_atomic32_read_acqb(&intrnl->misc.data.block_count); } } + + /* tse event returned in erts_thr_progress_unblock() */ return bc; } diff --git a/erts/emulator/beam/erl_thr_progress.h b/erts/emulator/beam/erl_thr_progress.h index 00a9e61407..3272926365 100644 --- a/erts/emulator/beam/erl_thr_progress.h +++ b/erts/emulator/beam/erl_thr_progress.h @@ -68,6 +68,7 @@ typedef struct { int leader; /* Needs to be first in the managed threads part */ int active; + int is_deep_sleeper; ErtsThrPrgrVal confirmed; ErtsThrPrgrLeaderState leader_state; } ErtsThrPrgrData; @@ -124,7 +125,7 @@ extern ErtsThrPrgr erts_thr_prgr__; void erts_thr_progress_pre_init(void); void erts_thr_progress_init(int no_schedulers, int managed, int unmanaged); ErtsThrPrgrData *erts_thr_progress_register_managed_thread( - ErtsSchedulerData *esdp, ErtsThrPrgrCallbacks *, int); + ErtsSchedulerData *esdp, ErtsThrPrgrCallbacks *, int, int); void erts_thr_progress_register_unmanaged_thread(ErtsThrPrgrCallbacks *); void erts_thr_progress_active(ErtsThrPrgrData *, int on); void erts_thr_progress_wakeup(ErtsThrPrgrData *, diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h index aedceb6fc2..d4f242236e 100644 --- a/erts/emulator/beam/erl_threads.h +++ b/erts/emulator/beam/erl_threads.h @@ -487,6 +487,7 @@ ERTS_GLB_INLINE void erts_tsd_key_delete(erts_tsd_key_t key); ERTS_GLB_INLINE void erts_tsd_set(erts_tsd_key_t key, void *value); ERTS_GLB_INLINE void * erts_tsd_get(erts_tsd_key_t key); ERTS_GLB_INLINE erts_tse_t *erts_tse_fetch(void); +ERTS_GLB_INLINE void erts_tse_use(erts_tse_t *ep); ERTS_GLB_INLINE void erts_tse_return(erts_tse_t *ep); ERTS_GLB_INLINE void erts_tse_prepare_timed(erts_tse_t *ep); ERTS_GLB_INLINE void erts_tse_set(erts_tse_t *ep); @@ -2359,6 +2360,23 @@ ERTS_GLB_INLINE erts_tse_t *erts_tse_fetch(void) return (erts_tse_t *) ethr_get_ts_event(); } +ERTS_GLB_INLINE void erts_tse_use(erts_tse_t *ep) +{ + /* + * When enabling use on event from emulator + * it *must* not already be in use... + */ +#ifdef DEBUG + erts_tse_t *tmp_ep; + ASSERT(!(ep->iflgs & ETHR_TS_EV_BUSY)); + tmp_ep = +#else + (void) +#endif + ethr_use_ts_event(ep); + ASSERT(ep == tmp_ep); +} + ERTS_GLB_INLINE void erts_tse_return(erts_tse_t *ep) { ethr_leave_ts_event(ep); @@ -2366,7 +2384,9 @@ ERTS_GLB_INLINE void erts_tse_return(erts_tse_t *ep) ERTS_GLB_INLINE void erts_tse_prepare_timed(erts_tse_t *ep) { - int res = ethr_event_prepare_timed(&((ethr_ts_event *) ep)->event); + int res; + ETHR_ASSERT(ep->iflgs & ETHR_TS_EV_BUSY); + res = ethr_event_prepare_timed(&((ethr_ts_event *) ep)->event); if (res != 0) erts_thr_fatal_error(res, "prepare timed"); } @@ -2378,6 +2398,7 @@ ERTS_GLB_INLINE void erts_tse_set(erts_tse_t *ep) ERTS_GLB_INLINE void erts_tse_reset(erts_tse_t *ep) { + ETHR_ASSERT(ep->iflgs & ETHR_TS_EV_BUSY); ethr_event_reset(&((ethr_ts_event *) ep)->event); } @@ -2385,6 +2406,7 @@ ERTS_GLB_INLINE int erts_tse_wait(erts_tse_t *ep) { int res; ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP); + ETHR_ASSERT(ep->iflgs & ETHR_TS_EV_BUSY); res = ethr_event_wait(&((ethr_ts_event *) ep)->event); ERTS_MSACC_POP_STATE(); return res; @@ -2394,6 +2416,7 @@ ERTS_GLB_INLINE int erts_tse_swait(erts_tse_t *ep, int spincount) { int res; ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP); + ETHR_ASSERT(ep->iflgs & ETHR_TS_EV_BUSY); res = ethr_event_swait(&((ethr_ts_event *) ep)->event, spincount); ERTS_MSACC_POP_STATE(); return res; @@ -2403,6 +2426,7 @@ ERTS_GLB_INLINE int erts_tse_twait(erts_tse_t *ep, Sint64 tmo) { int res; ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP); + ETHR_ASSERT(ep->iflgs & ETHR_TS_EV_BUSY); res = ethr_event_twait(&((ethr_ts_event *) ep)->event, (ethr_sint64_t) tmo); ERTS_MSACC_POP_STATE(); @@ -2413,6 +2437,7 @@ ERTS_GLB_INLINE int erts_tse_stwait(erts_tse_t *ep, int spincount, Sint64 tmo) { int res; ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP); + ETHR_ASSERT(ep->iflgs & ETHR_TS_EV_BUSY); res = ethr_event_stwait(&((ethr_ts_event *) ep)->event, spincount, (ethr_sint64_t) tmo); diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index ae7084b7f4..205a616c59 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -2188,11 +2188,12 @@ sys_msg_dispatcher_wait(void *vwait_p) erts_mtx_unlock(&smq_mtx); } +static ErtsSysMsgQ *local_sys_message_queue = NULL; + static void * sys_msg_dispatcher_func(void *unused) { ErtsThrPrgrCallbacks callbacks; - ErtsSysMsgQ *local_sys_message_queue = NULL; ErtsThrPrgrData *tpd; int wait = 0; @@ -2200,13 +2201,15 @@ sys_msg_dispatcher_func(void *unused) erts_lc_set_thread_name("system message dispatcher"); #endif + local_sys_message_queue = NULL; + callbacks.arg = (void *) &wait; callbacks.wakeup = sys_msg_dispatcher_wakeup; callbacks.prepare_wait = sys_msg_dispatcher_prep_wait; callbacks.wait = sys_msg_dispatcher_wait; callbacks.finalize_wait = sys_msg_dispatcher_fin_wait; - tpd = erts_thr_progress_register_managed_thread(NULL, &callbacks, 0); + tpd = erts_thr_progress_register_managed_thread(NULL, &callbacks, 0, 0); while (1) { int end_wait = 0; @@ -2225,6 +2228,7 @@ sys_msg_dispatcher_func(void *unused) /* Fetch current trace message queue ... */ if (!sys_message_queue) { + wait = 1; erts_mtx_unlock(&smq_mtx); end_wait = 1; erts_thr_progress_active(tpd, 0); @@ -2232,8 +2236,23 @@ sys_msg_dispatcher_func(void *unused) erts_mtx_lock(&smq_mtx); } - while (!sys_message_queue) - erts_cnd_wait(&smq_cnd, &smq_mtx); + while (!sys_message_queue) { + if (wait) + erts_cnd_wait(&smq_cnd, &smq_mtx); + if (sys_message_queue) + break; + wait = 1; + erts_mtx_unlock(&smq_mtx); + /* + * Ensure thread progress continue. We might have + * been the last thread to go to sleep. In that case + * erts_thr_progress_finalize_wait() will take care + * of it... + */ + erts_thr_progress_finalize_wait(tpd); + erts_thr_progress_prepare_wait(tpd); + erts_mtx_lock(&smq_mtx); + } local_sys_message_queue = sys_message_queue; sys_message_queue = NULL; @@ -2256,6 +2275,8 @@ sys_msg_dispatcher_func(void *unused) Process *proc = NULL; Port *port = NULL; + ASSERT(is_value(smqp->msg)); + if (erts_thr_progress_update(tpd)) erts_thr_progress_leader_update(tpd); @@ -2368,6 +2389,7 @@ sys_msg_dispatcher_func(void *unused) erts_fprintf(stderr, "dropped\n"); #endif } + smqp->msg = THE_NON_VALUE; } } @@ -2375,32 +2397,38 @@ sys_msg_dispatcher_func(void *unused) } void -erts_foreach_sys_msg_in_q(void (*func)(Eterm, - Eterm, - Eterm, - ErlHeapFragment *)) +erts_debug_foreach_sys_msg_in_q(void (*func)(Eterm, + Eterm, + Eterm, + ErlHeapFragment *)) { - ErtsSysMsgQ *sm; - erts_mtx_lock(&smq_mtx); - for (sm = sys_message_queue; sm; sm = sm->next) { - Eterm to; - switch (sm->type) { - case SYS_MSG_TYPE_SYSMON: - to = erts_get_system_monitor(); - break; - case SYS_MSG_TYPE_SYSPROF: - to = erts_get_system_profile(); - break; - case SYS_MSG_TYPE_ERRLGR: - to = erts_get_system_logger(); - break; - default: - to = NIL; - break; - } - (*func)(sm->from, to, sm->msg, sm->bp); + ErtsSysMsgQ *smq[] = {sys_message_queue, local_sys_message_queue}; + int i; + + ERTS_LC_ASSERT(erts_thr_progress_is_blocking()); + + for (i = 0; i < sizeof(smq)/sizeof(smq[0]); i++) { + ErtsSysMsgQ *sm; + for (sm = smq[i]; sm; sm = sm->next) { + Eterm to; + switch (sm->type) { + case SYS_MSG_TYPE_SYSMON: + to = erts_get_system_monitor(); + break; + case SYS_MSG_TYPE_SYSPROF: + to = erts_get_system_profile(); + break; + case SYS_MSG_TYPE_ERRLGR: + to = erts_get_system_logger(); + break; + default: + to = NIL; + break; + } + if (is_value(sm->msg)) + (*func)(sm->from, to, sm->msg, sm->bp); + } } - erts_mtx_unlock(&smq_mtx); } diff --git a/erts/emulator/beam/erl_trace.h b/erts/emulator/beam/erl_trace.h index b7844d1cb0..af38ef52db 100644 --- a/erts/emulator/beam/erl_trace.h +++ b/erts/emulator/beam/erl_trace.h @@ -90,10 +90,10 @@ int erts_is_tracer_valid(Process* p); void erts_check_my_tracer_proc(Process *); void erts_block_sys_msg_dispatcher(void); void erts_release_sys_msg_dispatcher(void); -void erts_foreach_sys_msg_in_q(void (*func)(Eterm, - Eterm, - Eterm, - ErlHeapFragment *)); +void erts_debug_foreach_sys_msg_in_q(void (*func)(Eterm, + Eterm, + Eterm, + ErlHeapFragment *)); Eterm erts_set_system_logger(Eterm); Eterm erts_get_system_logger(void); void erts_queue_error_logger_message(Eterm, Eterm, ErlHeapFragment *); diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 1ded5f031c..69194d7063 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -874,6 +874,7 @@ erts_prepare_dist_ext(ErtsDistExternal *edep, goto fail; #endif + edep->mld = dep->mld; erts_de_runlock(dep); return ERTS_PREP_DIST_EXT_SUCCESS; @@ -1224,7 +1225,7 @@ enum B2TState { /* order is somewhat significant */ }; typedef struct { - int heap_size; + Sint heap_size; int terms; byte* ep; int atom_extra_skip; @@ -4357,7 +4358,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, static Sint decoded_size(byte *ep, byte* endp, int internal_tags, B2TContext* ctx) { - int heap_size; + Sint heap_size; int terms; int atom_extra_skip; Uint n; diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h index edac177cc6..ef348fd7cd 100644 --- a/erts/emulator/beam/external.h +++ b/erts/emulator/beam/external.h @@ -129,6 +129,7 @@ typedef struct { Sint heap_size; Uint32 connection_id; Uint32 flags; + struct ErtsMonLnkDist__ *mld; /* copied from DistEntry.mld */ ErtsAtomTranslationTable attab; } ErtsDistExternal; diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index f564472081..a832327544 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -902,6 +902,12 @@ Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2); /* beam_bif_load.c */ Eterm erts_check_process_code(Process *c_p, Eterm module, int *redsp, int fcalls); Eterm erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed); +Uint32 erts_block_release_literal_area(void); +void erts_unblock_release_literal_area(Uint32); + +void erts_debug_foreach_release_literal_area_off_heap(void (*func)(ErlOffHeap *, void *), + void *arg); + typedef struct ErtsLiteralArea_ { struct erl_off_heap_header *off_heap; @@ -1251,6 +1257,10 @@ Uint erts_persistent_term_count(void); void erts_init_persistent_dumping(void); extern ErtsLiteralArea** erts_persistent_areas; extern Uint erts_num_persistent_areas; +void erts_debug_foreach_persistent_term_off_heap(void (*func)(ErlOffHeap *, void *), + void *arg); +int erts_debug_have_accessed_literal_area(ErtsLiteralArea *lap); +void erts_debug_save_accessed_literal_area(ErtsLiteralArea *lap); /* external.c */ void erts_init_external(void); diff --git a/erts/emulator/beam/instrs.tab b/erts/emulator/beam/instrs.tab index 42c1168f85..999e9337ff 100644 --- a/erts/emulator/beam/instrs.tab +++ b/erts/emulator/beam/instrs.tab @@ -951,19 +951,30 @@ raw_raise() { Eterm class = x(0); Eterm value = x(1); Eterm stacktrace = x(2); + Eterm* freason_ptr; + + /* + * Note that the i_raise instruction will override c_p->freason + * with the freason field stored inside the StackTrace struct in + * ftrace. Therefore, we must take care to store the class both + * inside the StackTrace struct and in c_p->freason (important if + * the class is different from the class of the original + * exception). + */ + freason_ptr = get_freason_ptr_from_exc(stacktrace); if (class == am_error) { - c_p->freason = EXC_ERROR & ~EXF_SAVETRACE; + *freason_ptr = c_p->freason = EXC_ERROR & ~EXF_SAVETRACE; c_p->fvalue = value; c_p->ftrace = stacktrace; goto find_func_info; } else if (class == am_exit) { - c_p->freason = EXC_EXIT & ~EXF_SAVETRACE; + *freason_ptr = c_p->freason = EXC_EXIT & ~EXF_SAVETRACE; c_p->fvalue = value; c_p->ftrace = stacktrace; goto find_func_info; } else if (class == am_throw) { - c_p->freason = EXC_THROWN & ~EXF_SAVETRACE; + *freason_ptr = c_p->freason = EXC_THROWN & ~EXF_SAVETRACE; c_p->fvalue = value; c_p->ftrace = stacktrace; goto find_func_info; diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 7322239a73..5bc2a3d62a 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -1192,22 +1192,17 @@ erts_schedule_proc2port_signal(Process *c_p, if (c_p) erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); - if (sched_res != 0) { - if (refp) { - /* - * We need to restore the message queue save - * pointer to the beginning of the message queue - * since the caller now wont wait for a message - * containing the reference created above... - */ - ASSERT(c_p); - erts_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - JOIN_MESSAGE(c_p); - erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - *refp = NIL; - } - return ERTS_PORT_OP_DROPPED; - } + /* + * Only report dropped if the operation fails to schedule + * and no message reference has been passed along. If + * message reference has been passed along, a message + * reply will be sent regardless of successful schedule + * or not, i.e. report scheduled. Abortion of port task + * will send message in case of failure. + */ + if (sched_res != 0 && !refp) + return ERTS_PORT_OP_DROPPED; + return ERTS_PORT_OP_SCHEDULED; } diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index a69da4d762..dc19e3df87 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -876,6 +876,9 @@ ERTS_GLB_INLINE void erts_refc_inc(erts_refc_t *refcp, erts_aint_t min_val); ERTS_GLB_INLINE erts_aint_t erts_refc_inc_unless(erts_refc_t *refcp, erts_aint_t unless_val, erts_aint_t min_val); +ERTS_GLB_INLINE void erts_refc_inc_if(erts_refc_t *refcp, + erts_aint_t if_val, + erts_aint_t min_val); ERTS_GLB_INLINE erts_aint_t erts_refc_inctest(erts_refc_t *refcp, erts_aint_t min_val); ERTS_GLB_INLINE void erts_refc_dec(erts_refc_t *refcp, erts_aint_t min_val); @@ -917,7 +920,7 @@ erts_refc_inc_unless(erts_refc_t *refcp, while (1) { erts_aint_t exp, new; #ifdef ERTS_REFC_DEBUG - if (val < 0) + if (val < min_val) erts_exit(ERTS_ABORT_EXIT, "erts_refc_inc_unless(): Bad refc found (refc=%ld < %ld)!\n", val, min_val); @@ -932,6 +935,27 @@ erts_refc_inc_unless(erts_refc_t *refcp, } } +ERTS_GLB_INLINE void +erts_refc_inc_if(erts_refc_t *refcp, + erts_aint_t if_val, + erts_aint_t min_val) +{ + erts_aint_t val = erts_atomic_read_nob((erts_atomic_t *) refcp); +#ifdef ERTS_REFC_DEBUG + if (val < min_val) + erts_exit(ERTS_ABORT_EXIT, + "erts_refc_inc_unless(): Bad refc found (refc=%ld < %ld)!\n", + val, min_val); +#endif + if (val == if_val) { + erts_atomic_cmpxchg_nob((erts_atomic_t *) refcp, val+1, val); + /* + * Ignore failure, as it means someone else took care of 'if_val'. + * Could be this function racing with itself. + */ + } +} + ERTS_GLB_INLINE erts_aint_t erts_refc_inctest(erts_refc_t *refcp, erts_aint_t min_val) { diff --git a/erts/emulator/beam/time.c b/erts/emulator/beam/time.c index a3069e419a..73538dc375 100644 --- a/erts/emulator/beam/time.c +++ b/erts/emulator/beam/time.c @@ -316,7 +316,7 @@ struct ErtsTimerWheel_ { #define ERTS_TW_SLOT_AT_ONCE (-1) #define ERTS_TW_BUMP_LATER_WHEEL(TIW) \ - ((tiw)->pos + ERTS_TW_LATER_WHEEL_SLOT_SIZE >= (TIW)->later.pos) + ((TIW)->pos + ERTS_TW_LATER_WHEEL_SLOT_SIZE >= (TIW)->later.pos) static int bump_later_wheel(ErtsTimerWheel *tiw, int *yield_count_p); @@ -480,6 +480,8 @@ find_next_timeout(ErtsSchedulerData *esdp, ErtsTimerWheel *tiw) ERTS_HARD_DBG_CHK_WHEELS(tiw, 0); + ERTS_TW_ASSERT(tiw->at_once.nto == 0); + ERTS_TW_ASSERT(tiw->nto == tiw->soon.nto + tiw->later.nto); ERTS_TW_ASSERT(tiw->yield_slot == ERTS_TW_SLOT_INACTIVE); if (tiw->nto == 0) { /* no timeouts in wheel */ @@ -701,7 +703,8 @@ remove_timer(ErtsTimerWheel *tiw, ErtsTWheelTimer *p) if (slot < ERTS_TW_SOON_WHEEL_END_SLOT) { if (empty_slot && tiw->true_next_timeout_time - && p->timeout_pos == tiw->next_timeout_pos) { + && p->timeout_pos == tiw->next_timeout_pos + && tiw->yield_slot == ERTS_TW_SLOT_INACTIVE) { tiw->true_next_timeout_time = 0; } if (--tiw->soon.nto == 0) @@ -714,7 +717,8 @@ remove_timer(ErtsTimerWheel *tiw, ErtsTWheelTimer *p) ErtsMonotonicTime tpos = tiw->later.min_tpos; tpos &= ERTS_TW_LATER_WHEEL_POS_MASK; tpos -= ERTS_TW_LATER_WHEEL_SLOT_SIZE; - if (tpos == tiw->next_timeout_pos) + if (tpos == tiw->next_timeout_pos + && tiw->yield_slot == ERTS_TW_SLOT_INACTIVE) tiw->true_next_timeout_time = 0; } if (--tiw->later.nto == 0) { @@ -864,6 +868,8 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) } if (tiw->pos >= bump_to) { + if (tiw->at_once.nto) + continue; ERTS_MSACC_POP_STATE_M_X(); break; } @@ -908,7 +914,6 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) { ErtsMonotonicTime tmp_slots = bump_to - tiw->pos; - tmp_slots = (bump_to - tiw->pos); if (tmp_slots < ERTS_TW_SOON_WHEEL_SIZE) slots = (int) tmp_slots; else diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index b71ce0389d..009b71c758 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2018. All Rights Reserved. + * Copyright Ericsson AB 1997-2019. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -3379,6 +3379,71 @@ static int udp_parse_ancillary_data(ErlDrvTermData *spec, int i, i = LOAD_NIL(spec, i); return LOAD_LIST(spec, i, n+1); } + +static int compile_ancillary_data(struct msghdr *mhdr, + char *ptr, ErlDrvSizeT anc_len) { + struct cmsghdr *cmsg; + size_t controllen = 0; + cmsg = CMSG_FIRSTHDR(mhdr); + for (;;) { + if (anc_len == 0) { + /* End of options to compile */ + mhdr->msg_controllen = controllen; + return 0; + } + if (cmsg == NULL) { + /* End of destination before end of options */ + return 1; + } + +#define COMPILE_ANCILLARY_DATA_ITEM(Level, Opt, Type, Get, Size) \ + do { \ + if (anc_len < (Size)) return 1; \ + sys_memset(cmsg, '\0', CMSG_SPACE(sizeof(Type))); \ + cmsg->cmsg_level = Level; \ + cmsg->cmsg_type = Opt; \ + cmsg->cmsg_len = CMSG_LEN(sizeof(Type)); \ + *((Type *) CMSG_DATA(cmsg)) = Get(ptr); \ + controllen += CMSG_SPACE(sizeof(Type)); \ + cmsg = CMSG_NXTHDR(mhdr, cmsg); \ + ptr += 4; \ + anc_len -= 4; \ + } while (0) +#define SIZEOF_ANCILLARY_DATA (2 * CMSG_SPACE(sizeof(int))) + /* (IP_TOS | IPV6_TCLASS) + IP_TTL */ + + switch (anc_len--, *ptr++) { + case INET_OPT_TOS: { +#if defined(IPPROTO_IP) && defined(IP_TOS) + COMPILE_ANCILLARY_DATA_ITEM(IPPROTO_IP, IP_TOS, int, get_int32, 4); +#else + return 1; /* Socket option not implemented */ +#endif + break; + } + case INET_OPT_TTL: { +#if defined(IPPROTO_IP) && defined(IP_TTL) + COMPILE_ANCILLARY_DATA_ITEM(IPPROTO_IP, IP_TTL, int, get_int32, 4); +#else + return 1; /* Socket option not implemented */ +#endif + break; + } + case INET_OPT_TCLASS: { +#if defined(IPPROTO_IPV6) && defined(IPV6_TCLASS) + COMPILE_ANCILLARY_DATA_ITEM(IPPROTO_IPV6, IPV6_TCLASS, int, get_int32, 4); +#else + return 1; /* Socket option not implemented */ +#endif + break; + } + default: + /* Unknow socket option */ + return 1; + } +#undef COMPILE_ANCILLARY_DATA_ITEM + } +} #endif /* ifndef __WIN32__ */ /* @@ -9846,10 +9911,8 @@ static tcp_descriptor* tcp_inet_copy(tcp_descriptor* desc,SOCKET s, copy_desc->send_timeout = desc->send_timeout; copy_desc->send_timeout_close = desc->send_timeout_close; - if (desc->tcp_add_flags & TCP_ADDF_SHOW_ECONNRESET) - copy_desc->tcp_add_flags |= TCP_ADDF_SHOW_ECONNRESET; - else - copy_desc->tcp_add_flags &= ~TCP_ADDF_SHOW_ECONNRESET; + copy_desc->tcp_add_flags = desc->tcp_add_flags + & (TCP_ADDF_SHOW_ECONNRESET | TCP_ADDF_LINGER_ZERO); /* The new port will be linked and connected to the original caller */ port = driver_create_port(port, owner, "tcp_inet", (ErlDrvData) copy_desc); @@ -9922,6 +9985,15 @@ static void tcp_inet_stop(ErlDrvData e) tcp_close_check(desc); tcp_clear_input(desc); +#ifdef HAVE_SENDFILE + if(desc->tcp_add_flags & TCP_ADDF_SENDFILE) { + desc->tcp_add_flags &= ~TCP_ADDF_SENDFILE; + close(desc->sendfile.dup_file_fd); + DEBUGF(("tcp_inet_stop(%p): SENDFILE dup closed %d\r\n", + desc->inet.port, desc->sendfile.dup_file_fd)); + } +#endif + DEBUGF(("tcp_inet_stop(%ld) }\r\n", (long)desc->inet.port)); inet_stop(INETP(desc)); } @@ -9937,12 +10009,6 @@ static void tcp_inet_stop(ErlDrvData e) * will be freed through tcp_inet_stop later on. */ static void tcp_desc_close(tcp_descriptor* desc) { -#ifdef HAVE_SENDFILE - if(desc->tcp_add_flags & TCP_ADDF_SENDFILE) { - desc->tcp_add_flags &= ~TCP_ADDF_SENDFILE; - close(desc->sendfile.dup_file_fd); - } -#endif tcp_clear_input(desc); tcp_clear_output(desc); @@ -10308,6 +10374,13 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd, return ctl_error(EINVAL, rbuf, rsize); } else if (!IS_CONNECTED(INETP(desc))) { return ctl_error(ENOTCONN, rbuf, rsize); + } else if (desc->tcp_add_flags & TCP_ADDF_SENDFILE) { + /* This should not happen as prim_inet.erl makes + sure that only the controlling process can + use the sendfile operation. But we add this + check here anyways just in case that prim_inet + is changed... */ + return ctl_error(EINVAL, rbuf, rsize); } sys_memcpy(&raw_file_fd, buf, sizeof(raw_file_fd)); @@ -10315,6 +10388,9 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd, desc->sendfile.dup_file_fd = dup(raw_file_fd); + DEBUGF(("tcp_inet_ctl(%p): SENDFILE dup %d\r\n", + desc->inet.port, desc->sendfile.dup_file_fd)); + if(desc->sendfile.dup_file_fd == -1) { return ctl_error(errno, rbuf, rsize); } @@ -10492,11 +10568,9 @@ static void tcp_inet_flush(ErlDrvData e) #ifdef HAVE_SENDFILE /* The old file driver aborted when it was stopped during sendfile, so - * we'll clear the flag and discard all output. */ + * we'll clear the flag and discard all output. It is the job of + * tcp_inet_stop to close the extra sendfile fd. */ if(desc->tcp_add_flags & TCP_ADDF_SENDFILE) { - desc->tcp_add_flags &= ~TCP_ADDF_SENDFILE; - close(desc->sendfile.dup_file_fd); - discard_output = 1; } #endif @@ -11386,7 +11460,7 @@ static int tcp_shutdown_error(tcp_descriptor* desc, int err) static void tcp_inet_delay_send(ErlDrvData data, ErlDrvTermData dummy) { tcp_descriptor *desc = (tcp_descriptor*)data; - (void)tcp_inet_output(desc, INETP(desc)->s); + (void)tcp_inet_output(desc, (HANDLE) INETP(desc)->s); } /* @@ -11634,6 +11708,9 @@ static int tcp_sendfile_completed(tcp_descriptor* desc) { desc->tcp_add_flags &= ~TCP_ADDF_SENDFILE; close(desc->sendfile.dup_file_fd); + DEBUGF(("tcp_sendfile_completed(%p): SENDFILE dup closed %d\r\n", + desc->inet.port, desc->sendfile.dup_file_fd)); + /* While we flushed the output queue prior to sending the file, we've * deferred clearing busy status until now as there's no point in doing so * while we still have a file to send. @@ -12553,7 +12630,7 @@ static void packet_inet_timeout(ErlDrvData e) sock_select(desc, FD_READ, 0); async_error_am (desc, am_timeout); } else { - (void)packet_inet_input(udesc, desc->s); + (void)packet_inet_input(udesc, (HANDLE) desc->s); } } @@ -12597,11 +12674,8 @@ static void packet_inet_command(ErlDrvData e, char* buf, ErlDrvSizeT len) char ancd[CMSG_SPACE(sizeof(*sri))]; } cmsg; - if (len < SCTP_GET_SENDPARAMS_LEN) { - inet_reply_error(desc, EINVAL); - return; - } - + if (len < SCTP_GET_SENDPARAMS_LEN) goto return_einval; + /* The ancillary data */ sri = (struct sctp_sndrcvinfo *) (CMSG_DATA(&cmsg.hdr)); /* Get the "sndrcvinfo" from the buffer, advancing the "ptr": */ @@ -12634,28 +12708,85 @@ static void packet_inet_command(ErlDrvData e, char* buf, ErlDrvSizeT len) goto check_result_code; } #endif - /* UDP socket. Even if it is connected, there is an address prefix - here -- ignored for connected sockets: */ - sz = len; - qtr = ptr; - xerror = inet_set_faddress(desc->sfamily, &other, &qtr, &sz); - if (xerror != NULL) { - inet_reply_error_am(desc, driver_mk_atom(xerror)); - return; - } - len -= (qtr - ptr); - ptr = qtr; - /* Now "ptr" is the user data ptr, "len" is data length: */ - inet_output_count(desc, len); - - if (desc->state & INET_F_ACTIVE) { /* connected (ignore address) */ - code = sock_send(desc->s, ptr, len, 0); - } - else { - code = sock_sendto(desc->s, ptr, len, 0, &other.sa, sz); + { + ErlDrvSizeT anc_len; + + /* UDP socket. Even if it is connected, there is an address prefix + here -- ignored for connected sockets: */ + sz = len; + qtr = ptr; + xerror = inet_set_faddress(desc->sfamily, &other, &qtr, &sz); + if (xerror != NULL) { + inet_reply_error_am(desc, driver_mk_atom(xerror)); + return; + } + len -= (qtr - ptr); + ptr = qtr; + + /* Here comes ancillary data */ + if (len < 4) goto return_einval; + anc_len = get_int32(ptr); + len -= 4; ptr += 4; + if (len < anc_len) goto return_einval; + + if (anc_len == 0 && !!0/*XXX-short-circuit-for-testing*/) { + /* Empty ancillary data */ + /* Now "ptr" is the user data ptr, "len" is data length: */ + inet_output_count(desc, len); + if (desc->state & INET_F_ACTIVE) { + /* connected (ignore address) */ + code = sock_send(desc->s, ptr, len, 0); + } + else { + code = sock_sendto(desc->s, ptr, len, 0, &other.sa, sz); + } + } + else { +#ifdef __WIN32__ + goto return_einval; /* Can not send ancillary data on Windows */ +#else + struct iovec iov[1]; + struct msghdr mhdr; + union { /* For ancillary data */ + struct cmsghdr hdr; + char ancd[SIZEOF_ANCILLARY_DATA]; + } cmsg; + sys_memset(&iov, '\0', sizeof(iov)); + sys_memset(&mhdr, '\0', sizeof(mhdr)); + sys_memset(&cmsg, '\0', sizeof(cmsg)); + if (desc->state & INET_F_ACTIVE) { + /* connected (ignore address) */ + mhdr.msg_name = NULL; + mhdr.msg_namelen = 0; + } + else { + mhdr.msg_name = &other; + mhdr.msg_namelen = sz; + } + mhdr.msg_control = cmsg.ancd; + mhdr.msg_controllen = sizeof(cmsg.ancd); + if (compile_ancillary_data(&mhdr, ptr, anc_len) != 0) { + goto return_einval; + } + if (mhdr.msg_controllen == 0) { + /* XXX Testing - only possible for anc_len == 0 */ + mhdr.msg_control = NULL; + } + len -= anc_len; + ptr += anc_len; + /* Now "ptr" is the user data ptr, "len" is data length: */ + iov[0].iov_len = len; + iov[0].iov_base = ptr; + mhdr.msg_iov = iov; + mhdr.msg_iovlen = 1; + mhdr.msg_flags = 0; + inet_output_count(desc, len); + code = sock_sendmsg(desc->s, &mhdr, 0); +#endif + } } -#ifdef HAVE_SCTP +#ifdef HAVE_SCTP check_result_code: /* "code" analysis is the same for both SCTP and UDP cases above: */ #endif @@ -12665,8 +12796,15 @@ static void packet_inet_command(ErlDrvData e, char* buf, ErlDrvSizeT len) } else inet_reply_ok(desc); + return; + + return_einval: + inet_reply_error(desc, EINVAL); + return; } -#endif + +#endif /* HAVE_UDP */ + #ifdef __WIN32__ static void packet_inet_event(ErlDrvData e, ErlDrvEvent event) diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c index c77a535105..637a0a9a2a 100644 --- a/erts/emulator/sys/common/erl_check_io.c +++ b/erts/emulator/sys/common/erl_check_io.c @@ -1603,7 +1603,7 @@ erts_create_pollset_thread(int id, ErtsThrPrgrData *tpd) { } void -erts_check_io(ErtsPollThread *psi, ErtsMonotonicTime timeout_time) +erts_check_io(ErtsPollThread *psi, ErtsMonotonicTime timeout_time, int poll_only_thread) { int pollres_len; int poll_ret, i; @@ -1617,6 +1617,9 @@ erts_check_io(ErtsPollThread *psi, ErtsMonotonicTime timeout_time) pollres_len = psi->pollres_len; + if (poll_only_thread) + erts_thr_progress_active(psi->tpd, 0); + #if ERTS_POLL_USE_FALLBACK if (psi->ps == get_fallback_pollset()) { @@ -1628,6 +1631,9 @@ erts_check_io(ErtsPollThread *psi, ErtsMonotonicTime timeout_time) poll_ret = erts_poll_wait(psi->ps, psi->pollres, &pollres_len, psi->tpd, timeout_time); } + if (poll_only_thread) + erts_thr_progress_active(psi->tpd, 1); + #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_check_exact(NULL, 0); /* No locks should be locked */ #endif @@ -1706,8 +1712,10 @@ erts_check_io(ErtsPollThread *psi, ErtsMonotonicTime timeout_time) reactive_events = state->active_events; - if (state->flags & ERTS_EV_FLAG_IN_SCHEDULER) + if (state->flags & ERTS_EV_FLAG_IN_SCHEDULER) { reactive_events &= ~ERTS_POLL_EV_IN; + state->active_events |= ERTS_POLL_EV_IN; + } /* Reactivate the poll op if there are still active events */ if (reactive_events) { diff --git a/erts/emulator/sys/common/erl_check_io.h b/erts/emulator/sys/common/erl_check_io.h index 31182be5ec..a422c78bd3 100644 --- a/erts/emulator/sys/common/erl_check_io.h +++ b/erts/emulator/sys/common/erl_check_io.h @@ -67,8 +67,12 @@ int erts_check_io_max_files(void); * not return unless erts_check_io_interrupt(pt, 1) is called by another thread. * * @param pt the poll thread structure to use. + * @param timeout_time timeout + * @param poll_only_thread non zero when poll is the only thing the + * calling thread does */ -void erts_check_io(struct erts_poll_thread *pt, ErtsMonotonicTime timeout_time); +void erts_check_io(struct erts_poll_thread *pt, ErtsMonotonicTime timeout_time, + int poll_only_thread); /** * Initialize the check io framework. This function will parse the arguments * and delete any entries that it is interested in. diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c index c71d23f58c..3beb88fb44 100644 --- a/erts/emulator/sys/common/erl_poll.c +++ b/erts/emulator/sys/common/erl_poll.c @@ -374,6 +374,7 @@ uint32_t epoll_events(int kp_fd, int fd); #define ERTS_POLL_NOT_WOKEN 0 #define ERTS_POLL_WOKEN -1 #define ERTS_POLL_WOKEN_INTR 1 +#define ERTS_POLL_WSTATE_UNUSED ~0 static ERTS_INLINE void reset_wakeup_state(ErtsPollSet *ps) @@ -384,12 +385,16 @@ reset_wakeup_state(ErtsPollSet *ps) static ERTS_INLINE int is_woken(ErtsPollSet *ps) { + if (!ERTS_POLL_USE_WAKEUP(ps)) + return 0; return erts_atomic32_read_acqb(&ps->wakeup_state) != ERTS_POLL_NOT_WOKEN; } static ERTS_INLINE int is_interrupted_reset(ErtsPollSet *ps) { + if (!ERTS_POLL_USE_WAKEUP(ps)) + return 0; return (erts_atomic32_xchg_acqb(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN) == ERTS_POLL_WOKEN_INTR); } @@ -397,7 +402,10 @@ is_interrupted_reset(ErtsPollSet *ps) static ERTS_INLINE void woke_up(ErtsPollSet *ps) { - erts_aint32_t wakeup_state = erts_atomic32_read_acqb(&ps->wakeup_state); + erts_aint32_t wakeup_state; + if (!ERTS_POLL_USE_WAKEUP(ps)) + return; + wakeup_state = erts_atomic32_read_acqb(&ps->wakeup_state); if (wakeup_state == ERTS_POLL_NOT_WOKEN) (void) erts_atomic32_cmpxchg_nob(&ps->wakeup_state, ERTS_POLL_WOKEN, @@ -450,6 +458,7 @@ cleanup_wakeup_pipe(ErtsPollSet *ps) int intr = 0; int fd = ps->wake_fds[0]; int res; + ASSERT(ERTS_POLL_USE_WAKEUP(ps)); do { char buf[32]; res = read(fd, buf, sizeof(buf)); @@ -475,6 +484,13 @@ create_wakeup_pipe(ErtsPollSet *ps) int wake_fds[2]; ps->wake_fds[0] = -1; ps->wake_fds[1] = -1; + if (!ERTS_POLL_USE_WAKEUP(ps)) { + erts_atomic32_init_nob(&ps->wakeup_state, + (erts_aint32_t) ERTS_POLL_WSTATE_UNUSED); + return; + } + erts_atomic32_init_nob(&ps->wakeup_state, + (erts_aint32_t) ERTS_POLL_NOT_WOKEN); if (pipe(wake_fds) < 0) { fatal_error("%s:%d:create_wakeup_pipe(): " "Failed to create pipe: %s (%d)\n", @@ -483,6 +499,7 @@ create_wakeup_pipe(ErtsPollSet *ps) erl_errno_id(errno), errno); } + SET_NONBLOCKING(wake_fds[0]); SET_NONBLOCKING(wake_fds[1]); @@ -629,12 +646,13 @@ int erts_poll_new_table_len(int old_len, int need_len) } else { new_len = old_len; + if (new_len < ERTS_FD_TABLE_MIN_LENGTH) + new_len = ERTS_FD_TABLE_MIN_LENGTH; do { if (new_len < ERTS_FD_TABLE_EXP_THRESHOLD) new_len *= 2; else new_len += ERTS_FD_TABLE_EXP_THRESHOLD; - } while (new_len < need_len); } ASSERT(new_len >= need_len); @@ -1938,8 +1956,7 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet *ps, ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_CHECK_IO); } - if (ERTS_POLL_USE_WAKEUP(ps)) - woke_up(ps); + woke_up(ps); if (res < 0) { #if ERTS_POLL_USE_SELECT @@ -2117,7 +2134,6 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(int id) ps->oneshot = 1; #endif - erts_atomic32_init_nob(&ps->wakeup_state, (erts_aint32_t) 0); create_wakeup_pipe(ps); #if ERTS_POLL_USE_TIMERFD diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 6a064ec8d4..9143460e74 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -130,7 +130,8 @@ MODULES= \ ignore_cores \ dgawd_handler \ random_iolist \ - crypto_reference + crypto_reference \ + literal_area_collector_test NO_OPT= bs_bincomp \ bs_bit_binaries \ diff --git a/erts/emulator/test/a_SUITE.erl b/erts/emulator/test/a_SUITE.erl index 5b04a15b85..f3752ab1c3 100644 --- a/erts/emulator/test/a_SUITE.erl +++ b/erts/emulator/test/a_SUITE.erl @@ -30,13 +30,14 @@ -include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0, init_per_suite/1, end_per_suite/1, - leaked_processes/1, long_timers/1, pollset_size/1]). + leaked_processes/1, long_timers/1, pollset_size/1, + used_thread_specific_events/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [leaked_processes, long_timers, pollset_size]. + [leaked_processes, long_timers, pollset_size, used_thread_specific_events]. %% Start some system servers now to avoid having them %% reported as leaks. @@ -95,6 +96,25 @@ pollset_size(Config) when is_list(Config) -> {comment, "Testcase started! This test will run in parallel with the " "erts testsuite and ends in the z_SUITE:pollset_size/1 testcase."}. +used_thread_specific_events(Config) when is_list(Config) -> + Parent = self(), + Go = make_ref(), + spawn(fun () -> + Name = used_thread_specific_events_holder, + true = register(Name, self()), + UsedTSE = erlang:system_info(ethread_used_tse), + io:format("UsedTSE: ~p~n", [UsedTSE]), + Parent ! Go, + receive + {get_used_tse, Pid} -> + Pid ! {used_tse, UsedTSE} + end + end), + receive Go -> ok end, + {comment, "Testcase started! This test will run in parallel with the " + "erts testsuite and ends in the z_SUITE:used_thread_specific_events/1 testcase."}. + + %% %% Internal functions... %% diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index 9e7bcd5255..9f6e1059b9 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -609,6 +609,16 @@ binary_to_existing_atom(Config) when is_list(Config) -> UnlikelyAtom = binary_to_atom(id(UnlikelyBin), latin1), UnlikelyAtom = binary_to_existing_atom(UnlikelyBin, latin1), + + %% ERL-944; a binary that was too large would overflow the latin1-to-utf8 + %% conversion buffer. + OverflowAtom = <<0:511/unit:8, + 196, 133, 196, 133, 196, 133, 196, 133, 196, 133, + 196, 133, 196, 133, 196, 133, 196, 133, 196, 133, + 196, 133, 196, 133, 196, 133, 196, 133, 196, 133, + 196, 133, 196, 133, 196, 133, 196, 133, 196, 133>>, + {'EXIT', _} = (catch binary_to_existing_atom(OverflowAtom, latin1)), + ok. diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index 23c675733c..0ce809a248 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -51,6 +51,7 @@ b2t_used_big/1, external_size/1, t_iolist_size/1, t_hash/1, + sub_bin_copy/1, bad_size/1, bad_term_to_binary/1, bad_binary_to_term_2/1,safe_binary_to_term2/1, @@ -78,6 +79,7 @@ all() -> b2t_used_big, bad_binary_to_term_2, safe_binary_to_term2, bad_binary_to_term, bad_terms, t_hash, bad_size, + sub_bin_copy, bad_term_to_binary, more_bad_terms, otp_5484, otp_5933, ordering, unaligned_order, gc_test, bit_sized_binary_sizes, otp_6817, otp_8117, deep, @@ -1586,6 +1588,42 @@ cmp_old_impl(Config) when is_list(Config) -> ok end. +%% OTP-16265 +%% This testcase is mainly targeted toward --enable-sharing-preserving. +sub_bin_copy(Config) when is_list(Config) -> + Papa = self(), + Echo = spawn_link(fun() -> echo(Papa) end), + HeapBin = list_to_binary(lists:seq(1,3)), + sub_bin_copy_1(HeapBin, Echo), + ProcBin = list_to_binary(lists:seq(1,65)), + sub_bin_copy_1(ProcBin, Echo), + unlink(Echo), + exit(Echo, kill), + ok. + +sub_bin_copy_1(RealBin, Echo) -> + Bits = bit_size(RealBin) - 1, + <<SubBin:Bits/bits, _/bits>> = RealBin, + + %% Send (copy) messages consisting of combinations of both + %% the SubBin and the RealBin it refers to. + [begin + Echo ! Combo, + {_, Combo} = {Combo, receive M -> M end} + end + || Len <- lists:seq(2,5), Combo <- combos([RealBin, SubBin], Len)], + ok. + +combos(_, 0) -> + [[]]; +combos(Elements, Len) -> + [[E | C] || E <- Elements, C <- combos(Elements,Len-1)]. + +echo(Papa) -> + receive M -> Papa ! M end, + echo(Papa). + + %% Utilities. huge_iolist(Lim) -> diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index cea6d240ad..a36015381c 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -350,8 +350,25 @@ constant_pools(Config) when is_list(Config) -> receive {'EXIT',NoOldHeap,{A,B,C}} -> ok; - Other -> - ct:fail({unexpected,Other}) + Other_NoOldHeap -> + ct:fail({unexpected,Other_NoOldHeap}) + end, + {module,literals} = erlang:load_module(literals, Code), + + %% Have a process with an inconsistent heap (legal while GC is disabled) + %% that references the literals in the 'literals' module. + InconsistentHeap = spawn_link(fun() -> inconsistent_heap(Self) end), + receive go -> ok end, + true = erlang:delete_module(literals), + false = erlang:check_process_code(InconsistentHeap, literals), + erlang:check_process_code(self(), literals), + true = erlang:purge_module(literals), + InconsistentHeap ! done, + receive + {'EXIT',InconsistentHeap,{A,B,C}} -> + ok; + Other_InconsistentHeap -> + ct:fail({unexpected,Other_InconsistentHeap}) end, {module,literals} = erlang:load_module(literals, Code), @@ -398,6 +415,7 @@ constant_pools(Config) when is_list(Config) -> end, HeapSz = TotHeapSz, %% Ensure restored to hibernated state... true = HeapSz > OldHeapSz, + literal_area_collector_test:check_idle(5000), ok. no_old_heap(Parent) -> @@ -421,6 +439,27 @@ old_heap(Parent) -> exit(Res) end. +inconsistent_heap(Parent) -> + A = literals:a(), + B = literals:b(), + C = literals:huge_bignum(), + Res = {A,B,C}, + Parent ! go, + + %% Disable the GC and return a tuple whose arity and contents are broken + BrokenTerm = erts_debug:set_internal_state(inconsistent_heap, start), + receive + after 5000 -> + %% Fix the tuple and enable the GC again + ok = erts_debug:set_internal_state(inconsistent_heap, BrokenTerm), + erlang:garbage_collect() + end, + + receive + done -> + exit(Res) + end. + hibernated(Parent) -> A = literals:a(), B = literals:b(), diff --git a/erts/emulator/test/dirty_nif_SUITE.erl b/erts/emulator/test/dirty_nif_SUITE.erl index 93d0ac392c..6f5ec161a3 100644 --- a/erts/emulator/test/dirty_nif_SUITE.erl +++ b/erts/emulator/test/dirty_nif_SUITE.erl @@ -34,7 +34,7 @@ dirty_scheduler_exit/1, dirty_call_while_terminated/1, dirty_heap_access/1, dirty_process_info/1, dirty_process_register/1, dirty_process_trace/1, - code_purge/1, dirty_nif_send_traced/1, + code_purge/1, literal_area/1, dirty_nif_send_traced/1, nif_whereis/1, nif_whereis_parallel/1, nif_whereis_proxy/1]). -define(nif_stub,nif_stub_error(?LINE)). @@ -52,6 +52,7 @@ all() -> dirty_process_register, dirty_process_trace, code_purge, + literal_area, dirty_nif_send_traced, nif_whereis, nif_whereis_parallel]. @@ -428,6 +429,7 @@ code_purge(Config) when is_list(Config) -> Time = erlang:convert_time_unit(End-Start, native, milli_seconds), io:format("Time=~p~n", [Time]), true = Time =< 1000, + literal_area_collector_test:check_idle(5000), ok. dirty_nif_send_traced(Config) when is_list(Config) -> @@ -458,6 +460,51 @@ dirty_nif_send_traced(Config) when is_list(Config) -> true = Time2 >= 1900, ok. +dirty_literal_test_code() -> + " +-module(dirty_literal_code_test). + +-export([get_literal/0]). + +get_literal() -> + {0,1,2,3,4,5,6,7,8,9}. + +". + +literal_area(Config) when is_list(Config) -> + NifTMO = 3000, + ExtraTMO = 1000, + TotTMO = NifTMO+ExtraTMO, + Path = ?config(data_dir, Config), + File = filename:join(Path, "dirty_literal_code_test.erl"), + ok = file:write_file(File, dirty_literal_test_code()), + {ok, dirty_literal_code_test, Bin} = compile:file(File, [binary]), + {module, dirty_literal_code_test} = erlang:load_module(dirty_literal_code_test, Bin), + Me = self(), + Fun = fun () -> + dirty_terminating_literal_access( + Me, + dirty_literal_code_test:get_literal()) + end, + {Pid, Mon} = spawn_monitor(Fun), + receive {dirty_alive, Pid} -> ok end, + exit(Pid, kill), + Start = erlang:monotonic_time(millisecond), + receive {'DOWN', Mon, process, Pid, killed} -> ok end, + true = erlang:delete_module(dirty_literal_code_test), + true = erlang:purge_module(dirty_literal_code_test), + End = erlang:monotonic_time(millisecond), + %% Wait for dirty_nif to do its access... + TMO = case End - Start of + T when T < TotTMO -> + TotTMO-T; + _ -> + 0 + end, + receive after TMO -> ok end, + literal_area_collector_test:check_idle(100), + {comment, "Waited "++integer_to_list(TMO)++" milliseconds after purge"}. + %% %% Internal... %% @@ -680,6 +727,7 @@ dirty_sleeper(_) -> ?nif_stub. dirty_heap_access_nif(_) -> ?nif_stub. whereis_term(_Type,_Name) -> ?nif_stub. whereis_send(_Type,_Name,_Msg) -> ?nif_stub. +dirty_terminating_literal_access(_Me, _Literal) -> ?nif_stub. nif_stub_error(Line) -> exit({nif_not_loaded,module,?MODULE,line,Line}). diff --git a/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c b/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c index a94a2c0b02..f5eb809cf8 100644 --- a/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c +++ b/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c @@ -412,6 +412,62 @@ whereis_send(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) return whereis_result_term(env, rc); } +static ERL_NIF_TERM dirty_terminating_literal_access(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPid to, self; + ERL_NIF_TERM copy, self_term, result; + ErlNifEnv* copy_env, *menv; + + /* + * Pid of test proc in argv[0] + * A literal term in argv[1] + */ + + if (argc != 2) + return enif_make_badarg(env); + + if (!enif_get_local_pid(env, argv[0], &to)) + return enif_make_badarg(env); + + if (!enif_self(env, &self)) + return enif_make_badarg(env); + + self_term = enif_make_pid(env, &self); + + copy_env = enif_alloc_env(); + copy = enif_make_copy(copy_env, argv[1]); + if (!enif_is_identical(copy, argv[1])) + return enif_make_badarg(env); + + menv = enif_alloc_env(); + result = enif_make_tuple2(menv, enif_make_atom(menv, "dirty_alive"), self_term); + enif_send(env, &to, menv, result); + enif_free_env(menv); + + while (enif_is_current_process_alive(env)); + + /* Give the system time to try and remove the literal area */ + +#ifdef __WIN32__ + Sleep(3000); +#else + sleep(3); +#endif + + /* + * If the system was successful in removing the area, + * the debug compiled emulator will have overwritten + * the data referred by argv[1] + */ + + if (!enif_is_identical(copy, argv[1])) + abort(); + + enif_free_env(copy_env); + + return self_term; +} + static ErlNifFunc nif_funcs[] = { @@ -426,7 +482,8 @@ static ErlNifFunc nif_funcs[] = {"dirty_call_while_terminated_nif", 1, dirty_call_while_terminated_nif, ERL_NIF_DIRTY_JOB_CPU_BOUND}, {"dirty_heap_access_nif", 1, dirty_heap_access_nif, ERL_NIF_DIRTY_JOB_CPU_BOUND}, {"whereis_send", 3, whereis_send, ERL_NIF_DIRTY_JOB_IO_BOUND}, - {"whereis_term", 2, whereis_term, ERL_NIF_DIRTY_JOB_CPU_BOUND} + {"whereis_term", 2, whereis_term, ERL_NIF_DIRTY_JOB_CPU_BOUND}, + {"dirty_terminating_literal_access", 2, dirty_terminating_literal_access, ERL_NIF_DIRTY_JOB_CPU_BOUND}, }; ERL_NIF_INIT(dirty_nif_SUITE,nif_funcs,load,NULL,NULL,NULL) diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index 1d2ae4fb51..2fd31ad8d3 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -82,6 +82,8 @@ consume_timeslice/1, env/1, poll_pipe/1, + lots_of_used_fds_on_boot/1, + lots_of_used_fds_on_boot_slave/1, z_test/1]). -export([bin_prefix/2]). @@ -182,7 +184,9 @@ groups() -> [a_test, use_fallback_pollset, bad_fd_in_pollset, fd_change, steal_control, smp_select, - driver_select_use, z_test]}, + driver_select_use, + lots_of_used_fds_on_boot, + z_test]}, {ioq_exit, [], [ioq_exit_ready_input, ioq_exit_ready_output, ioq_exit_timeout, ioq_exit_ready_async, @@ -1838,6 +1842,79 @@ driver_select_use0(Config) -> ok = erl_ddll:stop(), ok. +lots_of_used_fds_on_boot(Config) -> + case os:type() of + {unix, _} -> lots_of_used_fds_on_boot_test(Config); + _ -> {skipped, "Unix only test"} + end. + +lots_of_used_fds_on_boot_test(Config) -> + %% Start a node in a wrapper which have lots of fds + %% open. This used to hang the whole VM at boot in + %% an eternal loop trying to figure out how to size + %% arrays in erts_poll() implementation. + Name = lots_of_used_fds_on_boot, + HostSuffix = lists:dropwhile(fun ($@) -> false; (_) -> true end, + atom_to_list(node())), + FullName = list_to_atom(atom_to_list(Name) ++ HostSuffix), + Pa = filename:dirname(code:which(?MODULE)), + Prog = case catch init:get_argument(progname) of + {ok,[[P]]} -> P; + _ -> exit(no_progname_argument_found) + end, + NameSw = case net_kernel:longnames() of + false -> "-sname "; + true -> "-name "; + _ -> exit(not_distributed_node) + end, + {ok, Pwd} = file:get_cwd(), + NameStr = atom_to_list(Name), + DataDir = proplists:get_value(data_dir, Config), + Wrapper = filename:join(DataDir, "lots_of_fds_used_wrapper"), + CmdLine = Wrapper ++ " " ++ Prog ++ " -noshell -noinput " + ++ NameSw ++ " " ++ NameStr ++ " " + ++ "-pa " ++ Pa ++ " " + ++ "-env ERL_CRASH_DUMP " ++ Pwd ++ "/erl_crash_dump." ++ NameStr ++ " " + ++ "-setcookie " ++ atom_to_list(erlang:get_cookie()) ++ " " + ++ "-s " ++ atom_to_list(?MODULE) ++ " lots_of_used_fds_on_boot_slave " + ++ atom_to_list(node()), + io:format("Starting node ~p: ~s~n", [FullName, CmdLine]), + net_kernel:monitor_nodes(true), + Port = case open_port({spawn, CmdLine}, [exit_status]) of + Prt when is_port(Prt) -> + Prt; + OPError -> + exit({failed_to_start_node, {open_port_error, OPError}}) + end, + receive + {Port, {exit_status, 17}} -> + {skip, "Cannot open enough fds to test this"}; + {Port, {exit_status, Error}} -> + exit({failed_to_start_node, {exit_status, Error}}); + {nodeup, FullName} -> + io:format("~p connected!~n", [FullName]), + FullName = rpc:call(FullName, erlang, node, []), + rpc:cast(FullName, erlang, halt, []), + receive + {Port, {exit_status, 0}} -> + ok; + {Port, {exit_status, Error}} -> + exit({unexpected_exit_status, Error}) + after 5000 -> + exit(missing_exit_status) + end + after 5000 -> + exit(connection_timeout) + end. + +lots_of_used_fds_on_boot_slave([Master]) -> + erlang:monitor_node(Master, true), + receive + {nodedown, Master} -> + erlang:halt() + end, + ok. + thread_mseg_alloc_cache_clean(Config) when is_list(Config) -> case {erlang:system_info(threads), erlang:system_info({allocator,mseg_alloc}), diff --git a/erts/emulator/test/driver_SUITE_data/Makefile.src b/erts/emulator/test/driver_SUITE_data/Makefile.src index bcabaa689d..77cbd34fb1 100644 --- a/erts/emulator/test/driver_SUITE_data/Makefile.src +++ b/erts/emulator/test/driver_SUITE_data/Makefile.src @@ -1,3 +1,7 @@ +CC = @CC@ +LD = @LD@ +CFLAGS = @CFLAGS@ @DEFS@ +CROSSLDFLAGS = @CROSSLDFLAGS@ MISC_DRVS = outputv_drv@dll@ \ timer_drv@dll@ \ @@ -30,7 +34,15 @@ VSN_MISMATCH_DRVS = zero_extended_marker_garb_drv@dll@ \ smaller_major_vsn_drv@dll@ \ smaller_minor_vsn_drv@dll@ -all: $(MISC_DRVS) $(SYS_INFO_DRVS) $(VSN_MISMATCH_DRVS) +PROGS = lots_of_fds_used_wrapper@exe@ + +all: $(MISC_DRVS) $(SYS_INFO_DRVS) $(VSN_MISMATCH_DRVS) $(PROGS) + +lots_of_fds_used_wrapper@exe@: lots_of_fds_used_wrapper@obj@ + $(LD) $(CROSSLDFLAGS) -o lots_of_fds_used_wrapper lots_of_fds_used_wrapper@obj@ @LIBS@ + +lots_of_fds_used_wrapper@obj@: lots_of_fds_used_wrapper.c + $(CC) -c -o lots_of_fds_used_wrapper@obj@ $(CFLAGS) lots_of_fds_used_wrapper.c @SHLIB_RULES@ diff --git a/erts/emulator/test/driver_SUITE_data/lots_of_fds_used_wrapper.c b/erts/emulator/test/driver_SUITE_data/lots_of_fds_used_wrapper.c new file mode 100644 index 0000000000..34d84827d5 --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/lots_of_fds_used_wrapper.c @@ -0,0 +1,61 @@ +#if !defined(__WIN32__) +#include <sys/types.h> +#include <sys/stat.h> +#include <fcntl.h> +#include <unistd.h> +#include <stdlib.h> +#include <stdio.h> +#endif + +int +main(int argc, char *argv[]) +{ +#if !defined(__WIN32__) + + char **exec_argv; + int fds[12000]; + int max = sizeof(fds)/sizeof(fds[0]); + int i; + + /* Open a bit more than 1024 file descriptors... */ + for (i = 0; i < max; i++) { + fds[i] = open("/dev/null", 0, O_WRONLY); + if (fds[i] < 0) { + if (i < 1200) + return 17; /* Not enough fds for the test... */ + max = i; + break; + } + } + + /* + * Close some of the latest fds to give room for + * the emulators usage... + */ + for (i = max-150; i < max; i++) + close(fds[i]); + + if (argc < 2) + return 1; + + /* + * Ensure NULL pointer after last argument... + */ + exec_argv = malloc(sizeof(char *)*argc); + if (!exec_argv) + return 2; + + for (i = 0; i < argc-1; i++) { + /* printf("arg=%d: %s\n", i, argv[i+1]); */ + exec_argv[i] = argv[i+1]; + } + exec_argv[i] = NULL; + + execvp(exec_argv[0], exec_argv); + + perror("Failed to exec"); + +#endif + + return 3; +} diff --git a/erts/emulator/test/driver_SUITE_data/peek_non_existing_queue_drv.c b/erts/emulator/test/driver_SUITE_data/peek_non_existing_queue_drv.c index 685cda3e07..b69d75c31d 100644 --- a/erts/emulator/test/driver_SUITE_data/peek_non_existing_queue_drv.c +++ b/erts/emulator/test/driver_SUITE_data/peek_non_existing_queue_drv.c @@ -47,6 +47,10 @@ #include <windows.h> #endif +#ifdef HAVE_UNISTD_H +# include <unistd.h> +#endif + #include <errno.h> #include "erl_driver.h" diff --git a/erts/emulator/test/driver_SUITE_data/thr_msg_blast_drv.c b/erts/emulator/test/driver_SUITE_data/thr_msg_blast_drv.c index 56183c9484..503d8b902c 100644 --- a/erts/emulator/test/driver_SUITE_data/thr_msg_blast_drv.c +++ b/erts/emulator/test/driver_SUITE_data/thr_msg_blast_drv.c @@ -18,6 +18,10 @@ * %CopyrightEnd% */ +#include <stdio.h> +#include <string.h> +#include <stdlib.h> + #include "erl_driver.h" #define THR_MSG_BLAST_NO_PROCS 10 diff --git a/erts/emulator/test/dump_SUITE.erl b/erts/emulator/test/dump_SUITE.erl index d0237b78cc..0aba2b874c 100644 --- a/erts/emulator/test/dump_SUITE.erl +++ b/erts/emulator/test/dump_SUITE.erl @@ -65,12 +65,14 @@ signal_abort(Config) -> {ok, Node} = start_node(Config), - _P1 = spawn(Node, ?MODULE, load, []), - _P2 = spawn(Node, ?MODULE, load, []), - _P3 = spawn(Node, ?MODULE, load, []), - _P4 = spawn(Node, ?MODULE, load, []), - _P5 = spawn(Node, ?MODULE, load, []), - _P6 = spawn(Node, ?MODULE, load, []), + SO = rpc:call(Node, erlang, system_info, [schedulers_online]), + + _P1 = spawn_opt(Node, ?MODULE, load, [], [{scheduler, (0 rem SO) + 1}]), + _P2 = spawn_opt(Node, ?MODULE, load, [], [{scheduler, (1 rem SO) + 1}]), + _P3 = spawn_opt(Node, ?MODULE, load, [], [{scheduler, (2 rem SO) + 1}]), + _P4 = spawn_opt(Node, ?MODULE, load, [], [{scheduler, (3 rem SO) + 1}]), + _P5 = spawn_opt(Node, ?MODULE, load, [], [{scheduler, (4 rem SO) + 1}]), + _P6 = spawn_opt(Node, ?MODULE, load, [], [{scheduler, (5 rem SO) + 1}]), timer:sleep(500), diff --git a/erts/emulator/test/estone_SUITE_data/estone_cat.c b/erts/emulator/test/estone_SUITE_data/estone_cat.c index a34bda4384..cbdf3db6c9 100644 --- a/erts/emulator/test/estone_SUITE_data/estone_cat.c +++ b/erts/emulator/test/estone_SUITE_data/estone_cat.c @@ -12,9 +12,11 @@ #include <fcntl.h> #include <errno.h> -main(argc, argv) -int argc; -char *argv[]; +#ifdef HAVE_UNISTD_H +# include <unistd.h> +#endif + +int main(int argc, char* argv[]) { char buf[16384]; int n; diff --git a/erts/emulator/test/exception_SUITE.erl b/erts/emulator/test/exception_SUITE.erl index aec66cb9a3..6e6f7d78ab 100644 --- a/erts/emulator/test/exception_SUITE.erl +++ b/erts/emulator/test/exception_SUITE.erl @@ -23,6 +23,7 @@ -export([all/0, suite/0, badmatch/1, pending_errors/1, nil_arith/1, top_of_stacktrace/1, stacktrace/1, nested_stacktrace/1, raise/1, gunilla/1, per/1, + change_exception_class/1, exception_with_heap_frag/1, backtrace_depth/1, line_numbers/1]). @@ -43,6 +44,7 @@ suite() -> all() -> [badmatch, pending_errors, nil_arith, top_of_stacktrace, stacktrace, nested_stacktrace, raise, gunilla, per, + change_exception_class, exception_with_heap_frag, backtrace_depth, line_numbers]. -define(try_match(E), @@ -507,6 +509,38 @@ t1(_,X,_) -> t2(_,X,_) -> (X bsl 1) + 1. +change_exception_class(_Config) -> + try + change_exception_class_1(fun() -> throw(arne) end) + catch + error:arne -> + ok; + Class:arne -> + ct:fail({wrong_exception_class,Class}) + end. + +change_exception_class_1(F) -> + try + change_exception_class_2(F) + after + %% The exception would be caught and rethrown using + %% an i_raise instruction. Before the correction + %% of the raw_raise instruction, the change of class + %% would not stick. + io:put_chars("Exception automatically rethrown here\n") + end. + +change_exception_class_2(F) -> + try + F() + catch + throw:Reason:Stack -> + %% Translated to a raw_raise instruction. + %% The change of exception class would not stick + %% if the i_raise instruction was later executed. + erlang:raise(error, Reason, Stack) + end. + %% %% Make sure that even if a BIF builds an heap fragment, then causes an exception, %% the stacktrace term will still be OK (specifically, that it does not contain diff --git a/erts/emulator/test/list_bif_SUITE.erl b/erts/emulator/test/list_bif_SUITE.erl index f95251943d..b35ba0ff77 100644 --- a/erts/emulator/test/list_bif_SUITE.erl +++ b/erts/emulator/test/list_bif_SUITE.erl @@ -23,6 +23,7 @@ -export([all/0, suite/0]). -export([hd_test/1,tl_test/1,t_length/1,t_list_to_pid/1, + t_list_to_ref/1, t_list_to_ext_pidportref/1, t_list_to_port/1,t_list_to_float/1,t_list_to_integer/1]). @@ -33,6 +34,7 @@ suite() -> all() -> [hd_test, tl_test, t_length, t_list_to_pid, t_list_to_port, + t_list_to_ref, t_list_to_ext_pidportref, t_list_to_float, t_list_to_integer]. %% Tests list_to_integer and string:to_integer @@ -126,6 +128,57 @@ t_list_to_port(Config) when is_list(Config) -> end, ok. +t_list_to_ref(Config) when is_list(Config) -> + Ref = make_ref(), + RefStr = ref_to_list(Ref), + Ref = list_to_ref(RefStr), + case catch list_to_ref(id("Incorrect list")) of + {'EXIT', {badarg, _}} -> + ok; + Res -> + ct:fail("list_to_ref/1 with incorrect arg succeeded.~n" + "Result: ~p", [Res]) + end, + ok. + +%% Test list_to_pid/port/ref for external pids/ports/refs. +t_list_to_ext_pidportref(Config) when is_list(Config) -> + {ok, Node} = slave:start(net_adm:localhost(), t_list_to_ext_pidportref), + Pid = rpc:call(Node, erlang, self, []), + Port = hd(rpc:call(Node, erlang, ports, [])), + Ref = rpc:call(Node, erlang, make_ref, []), + + PidStr = pid_to_list(Pid), + PortStr = port_to_list(Port), + RefStr = ref_to_list(Ref), + + Pid2 = list_to_pid(PidStr), + Port2 = list_to_port(PortStr), + Ref2 = list_to_ref(RefStr), + + %% No, the local roundtrips of externals does not work + %% as 'creation' is missing in the string formats and we don't know + %% the 'creation' of the connected node. + false = (Pid =:= Pid2), + false = (Pid == Pid2), + false = (Port =:= Port2), + false = (Port == Port2), + false = (Ref =:= Ref2), + false = (Ref == Ref2), + + %% But it works when sent back to matching node name, as 0-creations + %% will be converted to the local node creation. + true = rpc:call(Node, erlang, '=:=', [Pid, Pid2]), + true = rpc:call(Node, erlang, '==', [Pid, Pid2]), + true = rpc:call(Node, erlang, '=:=', [Port, Port2]), + true = rpc:call(Node, erlang, '==', [Port, Port2]), + true = rpc:call(Node, erlang, '=:=', [Ref, Ref2]), + true = rpc:call(Node, erlang, '==', [Ref, Ref2]), + + slave:stop(Node), + ok. + + %% Test list_to_float/1 with correct and incorrect arguments. t_list_to_float(Config) when is_list(Config) -> diff --git a/erts/emulator/test/literal_area_collector_test.erl b/erts/emulator/test/literal_area_collector_test.erl new file mode 100644 index 0000000000..fb66add44c --- /dev/null +++ b/erts/emulator/test/literal_area_collector_test.erl @@ -0,0 +1,80 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(literal_area_collector_test). + +-export([check_idle/1]). + +check_idle(Timeout) when is_integer(Timeout) > 0 -> + Start = erlang:monotonic_time(millisecond), + LAC = find_lac(), + wait_until(fun () -> + case process_info(LAC, [status, + current_function, + current_stacktrace, + message_queue_len]) of + [{status,waiting}, + {current_function, + {erts_literal_area_collector,msg_loop,4}}, + {current_stacktrace, + [{erts_literal_area_collector,msg_loop,4,_}]}, + {message_queue_len,0}] -> + true; + CurrState -> + Now = erlang:monotonic_time(millisecond), + case Now - Start > Timeout of + true -> + exit({non_idle_literal_area_collecor, + CurrState}); + false -> + false + end + end + end), + ok. + + +find_lac() -> + try + lists:foreach(fun (P) -> + case process_info(P, initial_call) of + {initial_call, + {erts_literal_area_collector,start,0}} -> + throw({lac, P}); + _ -> + ok + end + end, processes()), + exit(no_literal_area_collector) + catch + throw:{lac, LAC} -> + LAC + end. + + +wait_until(Fun) -> + Res = try + Fun() + catch + T:R -> {T,R} + end, + case Res of + true -> ok; + _ -> wait_until(Fun) + end. diff --git a/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c b/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c index 46ee8b5540..6f662ae514 100644 --- a/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c +++ b/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c @@ -39,6 +39,7 @@ #include <errno.h> #include <stdio.h> +#include <string.h> static int fail(const char *file, int line, const char *function, const char *assertion); diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl index 300b4ed036..95de1cacdc 100644 --- a/erts/emulator/test/node_container_SUITE.erl +++ b/erts/emulator/test/node_container_SUITE.erl @@ -51,7 +51,8 @@ unique_pid/1, iter_max_procs/1, magic_ref/1, - dist_entry_gc/1]). + dist_entry_gc/1, + persistent_term/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -63,7 +64,8 @@ all() -> node_table_gc, dist_link_refc, dist_monitor_refc, node_controller_refc, ets_refc, match_spec_refc, timer_refc, pid_wrap, port_wrap, bad_nc, - unique_pid, iter_max_procs, magic_ref]. + unique_pid, iter_max_procs, + magic_ref, persistent_term]. init_per_suite(Config) -> Config. @@ -585,7 +587,17 @@ node_controller_refc(Config) when is_list(Config) -> wait_until(fun () -> not is_process_alive(P) end), lists:foreach(fun (Proc) -> garbage_collect(Proc) end, processes()), false = get_node_references({Node,Creation}), - false = get_dist_references(Node), + wait_until(fun () -> + case get_dist_references(Node) of + false -> + true; + [{{system,thread_progress_delete_timer}, + [{system,1}]}] -> + false; + Other -> + ct:fail(Other) + end + end), false = lists:member(Node, nodes(known)), nc_refc_check(node()), erts_debug:set_internal_state(node_tab_delayed_delete, -1), %% restore original value @@ -886,7 +898,22 @@ magic_ref(Config) when is_list(Config) -> {'DOWN', Mon, process, Pid, _} -> ok end, - {Addr0, 2, true} = erts_debug:get_internal_state({magic_ref,MRef0}), + MaxTime = erlang:monotonic_time(millisecond) + 1000, + %% The DOWN signal is sent before heap is cleaned up, + %% so we might need to wait some time after the DOWN + %% signal has been received before the heap actually + %% has been cleaned up... + wait_until(fun () -> + case erts_debug:get_internal_state({magic_ref,MRef0}) of + {Addr0, 2, true} -> + true; + {Addr0, 3, true} -> + true = MaxTime >= erlang:monotonic_time(millisecond), + false; + Error -> + ct:fail(Error) + end + end), id(MRef0), id(MRef1), MRefExt = term_to_binary(erts_debug:set_internal_state(make, magic_ref)), @@ -896,6 +923,44 @@ magic_ref(Config) when is_list(Config) -> true = erts_debug:get_internal_state({magic_ref,MRef2}), ok. +persistent_term(Config) when is_list(Config) -> + {ok, Node} = start_node(get_nodefirstname()), + Self = self(), + NcData = make_ref(), + RPid = spawn_link(Node, + fun () -> + Self ! {NcData, self(), hd(erlang:ports()), erlang:make_ref()} + end), + Data = receive + {NcData, RPid, RPort, RRef} -> + {RPid, RPort, RRef} + end, + unlink(RPid), + stop_node(Node), + Stuff = lists:foldl(fun (N, Acc) -> + persistent_term:put({?MODULE, N}, Data), + persistent_term:erase({?MODULE, N-1}), + node_container_refc_check(node()), + Data = persistent_term:get({?MODULE, N}), + try + persistent_term:get({?MODULE, N-1}) + catch + error:badarg -> + ok + end, + case N rem 4 of + 0 -> [persistent_term:get({?MODULE, N})|Acc]; + _ -> Acc + end + end, + [], + lists:seq(1, 100)), + persistent_term:erase({?MODULE, 100}), + receive after 2000 -> ok end, %% give literal gc some time to run... + node_container_refc_check(node()), + id(Stuff), + ok. + lost_pending_connection(Node) -> _ = (catch erts_internal:new_connection(Node)), diff --git a/erts/emulator/test/persistent_term_SUITE.erl b/erts/emulator/test/persistent_term_SUITE.erl index 93eb026ced..7c0b1ab3db 100644 --- a/erts/emulator/test/persistent_term_SUITE.erl +++ b/erts/emulator/test/persistent_term_SUITE.erl @@ -25,7 +25,7 @@ basic/1,purging/1,sharing/1,get_trapping/1, info/1,info_trapping/1,killed_while_trapping/1, off_heap_values/1,keys/1,collisions/1, - init_restart/1]). + init_restart/1,whole_message/1]). %% -export([test_init_restart_cmd/1]). @@ -37,7 +37,7 @@ suite() -> all() -> [basic,purging,sharing,get_trapping,info,info_trapping, killed_while_trapping,off_heap_values,keys,collisions, - init_restart]. + init_restart,whole_message]. init_per_suite(Config) -> %% Put a term in the dict so that we know that the testcases handle @@ -596,6 +596,48 @@ do_test_init_restart_cmd(File) -> init:stop() end. +%% Test that the literal is copied when removed also when +%% the whole message is a literal... + +whole_message(Config) when is_list(Config) -> + whole_message_test(on_heap), + whole_message_test(off_heap), + ok. + +whole_message_test(MQD) -> + io:format("Testing on ~p~n", [MQD]), + Go = make_ref(), + Done = make_ref(), + TestRef = make_ref(), + Tester = self(), + persistent_term:put(test_ref, TestRef), + Pid = spawn_opt(fun () -> + receive Go -> ok end, + receive TestRef -> ok end, + receive TestRef -> ok end, + receive TestRef -> ok end, + receive [TestRef] -> ok end, + receive [TestRef] -> ok end, + receive [TestRef] -> ok end, + Tester ! Done + end, [link, {message_queue_data, MQD}]), + Pid ! persistent_term:get(test_ref), + Pid ! persistent_term:get(test_ref), + Pid ! persistent_term:get(test_ref), + %% Throw in some messages with a reference from the heap + %% while we're at it... + Pid ! [persistent_term:get(test_ref)], + Pid ! [persistent_term:get(test_ref)], + Pid ! [persistent_term:get(test_ref)], + persistent_term:erase(test_ref), + receive after 1000 -> ok end, + Pid ! Go, + receive Done -> ok end, + unlink(Pid), + exit(Pid, kill), + false = is_process_alive(Pid), + ok. + %% Check that there is the same number of persistents terms before %% and after each test case. diff --git a/erts/emulator/test/port_bif_SUITE_data/port_test.c b/erts/emulator/test/port_bif_SUITE_data/port_test.c index 923ab99ccc..ef6d12dc93 100644 --- a/erts/emulator/test/port_bif_SUITE_data/port_test.c +++ b/erts/emulator/test/port_bif_SUITE_data/port_test.c @@ -10,6 +10,7 @@ #include <sys/types.h> #include <sys/stat.h> #include <fcntl.h> +#include <ctype.h> #ifndef __WIN32__ #include <unistd.h> @@ -32,7 +33,7 @@ exit(1); \ } -#define MAIN(argc, argv) main(argc, argv) +#define MAIN(argc, argv) int main(argc, argv) extern int errno; diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index fd770aaccd..aee64c2adb 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -62,7 +62,9 @@ system_task_on_suspended/1, system_task_failed_enqueue/1, gc_request_when_gc_disabled/1, - gc_request_blast_when_gc_disabled/1]). + gc_request_blast_when_gc_disabled/1, + otp_16436/1, + otp_16642/1]). -export([prio_server/2, prio_client/2, init/1, handle_event/2]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -110,7 +112,8 @@ groups() -> {system_task, [], [no_priority_inversion, no_priority_inversion2, system_task_blast, system_task_on_suspended, system_task_failed_enqueue, - gc_request_when_gc_disabled, gc_request_blast_when_gc_disabled]}]. + gc_request_when_gc_disabled, gc_request_blast_when_gc_disabled, + otp_16436, otp_16642]}]. init_per_suite(Config) -> A0 = case application:start(sasl) of @@ -1089,42 +1092,86 @@ process_info_status_handled_signal(Config) when is_list(Config) -> %% OTP-15709 %% Provoke a bug where process_info(reductions) returned wrong result %% because REDS_IN (def_arg_reg[5]) is read when the process in not running. +%% +%% And a bug where process_info(reductions) on a process which was releasing its +%% main lock during execution could result in negative reduction diffs. process_info_reductions(Config) when is_list(Config) -> - pi_reductions_tester(spawn_link(fun() -> pi_reductions_spinnloop() end)), - pi_reductions_tester(spawn_link(fun() -> pi_reductions_recvloop() end)), + {S1, S2} = case erlang:system_info(schedulers) of + 1 -> {1,1}; + _ -> {1,2} + end, + io:format("Run on schedulers ~p and ~p\n", [S1,S2]), + Boss = self(), + Doer = spawn_opt(fun () -> + pi_reductions_tester(true, 10, fun pi_reductions_spinnloop/0, S2), + pi_reductions_tester(true, 10, fun pi_reductions_recvloop/0, S2), + pi_reductions_tester(false, 100, fun pi_reductions_main_unlocker/0, S2), + Boss ! {self(), done} + end, + [link, {scheduler, S1}]), + + {Doer, done} = receive M -> M end, ok. -pi_reductions_tester(Pid) -> - {_, DiffList} = - lists:foldl(fun(_, {Prev, Acc}) -> - %% Add another item that force sending the request - %% as a signal, like 'current_function'. - PI = process_info(Pid, [reductions, current_function]), - [{reductions,Reds}, {current_function,_}] = PI, - Diff = Reds - Prev, - {Diff, true} = {Diff, (Diff >= 0)}, - {Diff, true} = {Diff, (Diff =< 1000*1000)}, - {Reds, [Diff | Acc]} - end, - {0, []}, - lists:seq(1,10)), +pi_reductions_tester(ForceSignal, MaxCalls, Fun, S2) -> + Pid = spawn_opt(Fun, [link, {scheduler,S2}]), + Extra = case ForceSignal of + true -> + %% Add another item that force sending the request + %% as a signal, like 'current_function'. + [current_function]; + false -> + [] + end, + LoopFun = fun Me(Calls, Prev, Acc0) -> + PI = process_info(Pid, [reductions | Extra]), + [{reductions,Reds} | _] = PI, + Diff = Reds - Prev, + %% Verify we get sane non-negative reduction diffs + {Diff, true} = {Diff, (Diff >= 0)}, + {Diff, true} = {Diff, (Diff =< 1000*1000)}, + Acc1 = [Diff | Acc0], + case Calls >= MaxCalls of + true -> Acc1; + false -> Me(Calls+1, Reds, Acc1) + end + end, + DiffList = LoopFun(0, 0, []), unlink(Pid), exit(Pid,kill), - io:format("Reduction diffs: ~p\n", [DiffList]), + io:format("Reduction diffs: ~p\n", [lists:reverse(DiffList)]), ok. pi_reductions_spinnloop() -> %% 6 args to make use of def_arg_reg[5] which is also used as REDS_IN - pi_reductions_spinnloop(1, atom, "hej", self(), make_ref(), 3.14). + pi_reductions_spinnloop(999*1000, atom, "hej", self(), make_ref(), 3.14). -pi_reductions_spinnloop(A,B,C,D,E,F) -> - pi_reductions_spinnloop(B,C,D,E,F,A). +pi_reductions_spinnloop(N,A,B,C,D,E) when N > 0 -> + pi_reductions_spinnloop(N-1,B,C,D,E,A); +pi_reductions_spinnloop(0,_,_,_,_,_) -> + %% Stop to limit max number of reductions consumed + pi_reductions_recvloop(). pi_reductions_recvloop() -> receive "a free lunch" -> false end. +pi_reductions_main_unlocker() -> + Other = spawn_link(fun() -> receive die -> ok end end), + pi_reductions_main_unlocker_loop(Other). + +pi_reductions_main_unlocker_loop(Other) -> + %% Assumption: register(OtherPid, Name) will unlock main lock of calling + %% process during execution. + register(pi_reductions_main_unlocker, Other), + unregister(pi_reductions_main_unlocker), + + %% Yield in order to increase probability of process_info sometimes probing + %% this process when it's not RUNNING. + erlang:yield(), + pi_reductions_main_unlocker_loop(Other). + %% Tests erlang:bump_reductions/1. bump_reductions(Config) when is_list(Config) -> @@ -2551,14 +2598,20 @@ garb_other_running(Config) when is_list(Config) -> no_priority_inversion(Config) when is_list(Config) -> Prio = process_flag(priority, max), - HTLs = lists:map(fun (_) -> + Master = self(), + Executing = make_ref(), + HTLs = lists:map(fun (Sched) -> spawn_opt(fun () -> + Master ! {self(), Executing}, tok_loop() end, - [{priority, high}, monitor, link]) + [{priority, high}, + {scheduler, Sched}, + monitor, + link]) end, - lists:seq(1, 2*erlang:system_info(schedulers))), - receive after 500 -> ok end, + lists:seq(1, erlang:system_info(schedulers_online))), + lists:foreach(fun ({P, _}) -> receive {P,Executing} -> ok end end, HTLs), LTL = spawn_opt(fun () -> tok_loop() end, @@ -2580,14 +2633,19 @@ no_priority_inversion(Config) when is_list(Config) -> no_priority_inversion2(Config) when is_list(Config) -> Prio = process_flag(priority, max), - MTLs = lists:map(fun (_) -> + Master = self(), + Executing = make_ref(), + MTLs = lists:map(fun (Sched) -> spawn_opt(fun () -> + Master ! {self(), Executing}, tok_loop() end, - [{priority, max}, monitor, link]) + [{priority, max}, + {scheduler, Sched}, + monitor, link]) end, - lists:seq(1, 2*erlang:system_info(schedulers))), - receive after 2000 -> ok end, + lists:seq(1, erlang:system_info(schedulers_online))), + lists:foreach(fun ({P, _}) -> receive {P,Executing} -> ok end end, MTLs), {PL, ML} = spawn_opt(fun () -> tok_loop() end, @@ -2808,9 +2866,130 @@ gc_request_blast_when_gc_disabled(Config) when is_list(Config) -> receive {'DOWN', M, process, P, _Reason} -> ok end, ok. +otp_16436(Config) when is_list(Config) -> + P = spawn_opt(fun () -> + erts_debug:dirty_io(wait, 1000) + end, + [{priority,high},link]), + erlang:check_process_code(P, non_existing), + unlink(P), + exit(P, kill), + ok. + +otp_16642(Config) when is_list(Config) -> + %% + %% Whitebox testing... + %% + %% Ensure that low prio system tasks are interleaved with + %% normal prio system tasks as they should. + %% + process_flag(priority, high), + process_flag(scheduler, 1), + Pid = spawn_opt(fun () -> receive after infinity -> ok end end, + [link, {scheduler, 1}]), + ReqSTasks = fun (Prio, Start, Stop) -> + lists:foreach( + fun (N) -> + erts_internal:request_system_task( + Pid, + Prio, + {system_task_test, + {Prio, N}}) + end, + lists:seq(Start, Stop)) + end, + MkResList = fun (Prio, Start, Stop) -> + lists:map(fun (N) -> + {system_task_test, + {Prio, N}, + true} + end, + lists:seq(Start, Stop)) + end, + + %%% Test when normal queue clears first... + + ReqSTasks(low, 0, 1), + ReqSTasks(normal, 0, 10), + ReqSTasks(low, 2, 4), + ReqSTasks(normal, 11, 26), + + Msgs1 = recv_msgs(32), + io:format("Got test 1 messages: ~p~n", [Msgs1]), + + ExpMsgs1 = + MkResList(normal, 0, 7) + ++ MkResList(low, 0, 0) + ++ MkResList(normal, 8, 15) + ++ MkResList(low, 1, 1) + ++ MkResList(normal, 16, 23) + ++ MkResList(low, 2, 2) + ++ MkResList(normal, 24, 26) + ++ MkResList(low, 3, 4), + + case Msgs1 =:= ExpMsgs1 of + true -> + ok; + false -> + io:format("Expected test 1 messages ~p~n", + [ExpMsgs1]), + ct:fail(unexpected_messages) + end, + + receive Unexp1 -> ct:fail({unexpected_message, Unexp1}) + after 500 -> ok + end, + + io:format("Test 1 as expected~n", []), + + %%% Test when low queue clears first... + + ReqSTasks(low, 0, 1), + ReqSTasks(normal, 0, 20), + + Msgs2 = recv_msgs(23), + io:format("Got test 2 messages: ~p~n", [Msgs2]), + + ExpMsgs2 = + MkResList(normal, 0, 7) + ++ MkResList(low, 0, 0) + ++ MkResList(normal, 8, 15) + ++ MkResList(low, 1, 1) + ++ MkResList(normal, 16, 20), + + case Msgs2 =:= ExpMsgs2 of + true -> + ok; + false -> + io:format("Expected test 2 messages ~p~n", + [ExpMsgs2]), + ct:fail(unexpected_messages) + end, + + receive Unexp2 -> ct:fail({unexpected_message, Unexp2}) + after 500 -> ok + end, + + io:format("Test 2 as expected~n", []), + + unlink(Pid), + exit(Pid, kill), + false = is_process_alive(Pid), + ok. %% Internal functions +recv_msgs(N) -> + recv_msgs(N, []). + +recv_msgs(0, Msgs) -> + lists:reverse(Msgs); +recv_msgs(N, Msgs) -> + receive + Msg -> + recv_msgs(N-1, [Msg|Msgs]) + end. + wait_until(Fun) -> case Fun() of true -> true; diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index f61949c75b..59cf66d277 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -58,7 +58,8 @@ scheduler_suspend/1, dirty_scheduler_threads/1, poll_threads/1, - reader_groups/1]). + reader_groups/1, + otp_16446/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -74,7 +75,8 @@ all() -> scheduler_suspend_basic, scheduler_suspend, dirty_scheduler_threads, poll_threads, - reader_groups]. + reader_groups, + otp_16446]. groups() -> [{scheduler_bind, [], @@ -1794,6 +1796,77 @@ reader_groups_map(CPUT, Groups) -> erlang:system_flag(cpu_topology, Old), lists:sort(Res). +otp_16446(Config) when is_list(Config) -> + ct:timetrap({minutes, 1}), + + process_flag(priority, high), + + DIO = erlang:system_info(dirty_io_schedulers), + NoPrioProcs = 10*DIO, + io:format("DIO = ~p~nNoPrioProcs = ~p~n", [DIO, NoPrioProcs]), + + DirtyLoop = fun Loop(P, N) -> + erts_debug:dirty_io(wait,1), + receive {get, From} -> From ! {P, N} + after 0 -> Loop(P,N+1) + end + end, + + Spawn = fun SpawnLoop(_Prio, 0, Acc) -> + Acc; + SpawnLoop(Prio, N, Acc) -> + Pid = spawn_opt(fun () -> DirtyLoop(Prio, 0) end, + [link, {priority, Prio}]), + SpawnLoop(Prio, N-1, [Pid|Acc]) + end, + + Ns = Spawn(normal, NoPrioProcs, []), + Ls = Spawn(low, NoPrioProcs, []), + + receive after 10000 -> ok end, + + RequestInfo = fun (P) -> P ! {get, self()} end, + lists:foreach(RequestInfo, Ns), + lists:foreach(RequestInfo, Ls), + + Collect = fun CollectFun(0, LLs, NLs) -> + {LLs, NLs}; + CollectFun(N, LLs, NLs) -> + receive + {low, Calls} -> + CollectFun(N-1, LLs+Calls, NLs); + {normal, Calls} -> + CollectFun(N-1, LLs, NLs+Calls) + end + end, + + {LLs, NLs} = Collect(2*NoPrioProcs, 0, 0), + + %% expected ratio 0.125, but this is not especially exact... + Ratio = LLs / NLs, + + io:format("LLs = ~p~nNLs = ~p~nRatio = ~p~n", [LLs, NLs, Ratio]), + + true = Ratio > 0.05, + true = Ratio < 0.5, + + WaitUntilDead = fun (P) -> + case is_process_alive(P) of + false -> + ok; + true -> + unlink(P), + exit(P, kill), + false = is_process_alive(P) + end + end, + + lists:foreach(WaitUntilDead, Ns), + lists:foreach(WaitUntilDead, Ls), + Comment = "low/normal ratio: " ++ erlang:float_to_list(Ratio,[{decimals,4}]), + erlang:display(Comment), + {comment, Comment}. + %% %% Utils %% diff --git a/erts/emulator/test/signal_SUITE.erl b/erts/emulator/test/signal_SUITE.erl index 4e6baa9e0e..0bfe7539b4 100644 --- a/erts/emulator/test/signal_SUITE.erl +++ b/erts/emulator/test/signal_SUITE.erl @@ -34,7 +34,8 @@ -export([init_per_testcase/2, end_per_testcase/2]). % Test cases --export([xm_sig_order/1]). +-export([xm_sig_order/1, + kill2killed/1]). init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> [{testcase, Func}|Config]. @@ -53,7 +54,8 @@ suite() -> {timetrap, {minutes, 2}}]. all() -> - [xm_sig_order]. + [xm_sig_order, + kill2killed]. %% Test that exit signals and messages are received in correct order @@ -89,6 +91,68 @@ xm_sig_order_proc() -> end, xm_sig_order_proc(). +kill2killed(Config) when is_list(Config) -> + process_flag(trap_exit, true), + kill2killed_test(node()), + {ok, Node} = start_node(Config), + kill2killed_test(Node), + stop_node(Node), + ok. + +kill2killed_test(Node) -> + if Node == node() -> + io:format("Testing against local node", []); + true -> + io:format("Testing against remote node ~p", [Node]) + end, + check_exit(Node, other_exit2, 1), + check_exit(Node, other_exit2, 2), + check_exit(Node, other_exit2, 9), + check_exit(Node, other_exit2, 10), + check_exit(Node, exit2, 1), + check_exit(Node, exit2, 2), + check_exit(Node, exit2, 9), + check_exit(Node, exit2, 10), + check_exit(Node, exit1, 1), + check_exit(Node, exit1, 2), + check_exit(Node, exit1, 9), + check_exit(Node, exit1, 10), + ok. + +check_exit(Node, Type, N) -> + io:format("Testing ~p length ~p~n", [Type, N]), + P = spawn_link_line(Node, node(), Type, N, self()), + if Type == other_exit2 -> + receive + {end_of_line, EOL} -> + exit(EOL, kill) + end; + true -> ok + end, + receive + {'EXIT', P, Reason} -> + if Type == exit1 -> + kill = Reason; + true -> + killed = Reason + end + end. + +spawn_link_line(_NodeA, _NodeB, other_exit2, 0, Tester) -> + Tester ! {end_of_line, self()}, + receive after infinity -> ok end; +spawn_link_line(_NodeA, _NodeB, exit1, 0, _Tester) -> + exit(kill); +spawn_link_line(_NodeA, _NodeB, exit2, 0, _Tester) -> + exit(self(), kill); +spawn_link_line(NodeA, NodeB, Type, N, Tester) -> + spawn_link(NodeA, + fun () -> + spawn_link_line(NodeB, NodeA, Type, N-1, Tester), + receive after infinity -> ok end + end). + + %% %% -- Internal utils -------------------------------------------------------- %% diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl index 4e663fed7f..da2c0ef8ac 100644 --- a/erts/emulator/test/system_info_SUITE.erl +++ b/erts/emulator/test/system_info_SUITE.erl @@ -37,10 +37,13 @@ -export([process_count/1, system_version/1, misc_smoke_tests/1, heap_size/1, wordsize/1, memory/1, ets_limit/1, atom_limit/1, + procs_bug/1, ets_count/1, atom_count/1, system_logger/1]). -export([init/1, handle_event/2, handle_call/2]). +-export([init_per_testcase/2, end_per_testcase/2]). + suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap, {minutes, 2}}]. @@ -48,8 +51,20 @@ suite() -> all() -> [process_count, system_version, misc_smoke_tests, ets_count, heap_size, wordsize, memory, ets_limit, atom_limit, atom_count, + procs_bug, system_logger]. + +init_per_testcase(procs_bug, Config) -> + procs_bug(init_per_testcase, Config); +init_per_testcase(_, Config) -> + Config. + +end_per_testcase(procs_bug, Config) -> + procs_bug(end_per_testcase, Config); +end_per_testcase(_, _) -> + ok. + %%% %%% The test cases ------------------------------------------------------------- %%% @@ -649,3 +664,41 @@ handle_call(Msg, State) -> handle_event(Event, State) -> State ! {report_handler, Event}, {ok, State}. + + +%% OTP-15909: Provoke bug that would cause VM crash +%% if doing system_info(procs) when process have queued exit/down signals. +procs_bug(init_per_testcase, Config) -> + %% Use single scheduler and process prio to starve monitoring processes + %% from handling their received DOWN signals. + OldSchedOnline = erlang:system_flag(schedulers_online,1), + [{schedulers_online, OldSchedOnline} | Config]; +procs_bug(end_per_testcase, Config) -> + erlang:system_flag(schedulers_online, + proplists:get_value(schedulers_online, Config)), + ok. + +procs_bug(Config) when is_list(Config) -> + {Monee,_} = spawn_opt(fun () -> receive die -> ok end end, + [monitor,{priority,max}]), + Papa = self(), + Pids = [begin + P = spawn_opt(fun () -> + erlang:monitor(process, Monee), + Papa ! {self(),ready}, + receive "nada" -> no end + end, + [link, {priority,normal}]), + {P, ready} = receive M -> M end, + P + end + || _ <- lists:seq(1,10)], + process_flag(priority,high), + Monee ! die, + {'DOWN',_,process,Monee,normal} = receive M -> M end, + + %% This call did crash VM as Pids have pending DOWN signals. + erlang:system_info(procs), + process_flag(priority,normal), + [begin unlink(P), exit(P, kill) end || P <- Pids], + ok. diff --git a/erts/emulator/test/timer_bif_SUITE.erl b/erts/emulator/test/timer_bif_SUITE.erl index fc11a04a31..71ab84edd6 100644 --- a/erts/emulator/test/timer_bif_SUITE.erl +++ b/erts/emulator/test/timer_bif_SUITE.erl @@ -30,7 +30,9 @@ cleanup/1, evil_timers/1, registered_process/1, same_time_yielding/1, same_time_yielding_with_cancel/1, same_time_yielding_with_cancel_other/1, % same_time_yielding_with_cancel_other_accessor/1, - auto_cancel_yielding/1]). + auto_cancel_yielding/1, + suspended_scheduler_timeout/1, + multizero_timeout_in_timeout/1]). -include_lib("common_test/include/ct.hrl"). @@ -68,7 +70,9 @@ all() -> same_time_yielding, same_time_yielding_with_cancel, same_time_yielding_with_cancel_other, % same_time_yielding_with_cancel_other_accessor, - auto_cancel_yielding]. + auto_cancel_yielding, + suspended_scheduler_timeout, + multizero_timeout_in_timeout]. %% Basic start_timer/3 functionality @@ -630,6 +634,51 @@ auto_cancel_yielding(Config) when is_list(Config) -> Mem = mem(), ok. +suspended_scheduler_timeout(Config) when is_list(Config) -> + Ref = make_ref(), + SchdlrsOnln = erlang:system_info(schedulers_online), + lists:foreach(fun (Sched) -> + process_flag(scheduler, Sched), + erlang:send_after(1000, self(), {Ref, Sched}) + end, + lists:seq(1, SchdlrsOnln)), + process_flag(scheduler, 0), + erlang:system_flag(schedulers_online, 1), + try + lists:foreach(fun (Sched) -> + receive + {Ref, Sched} -> + ok + after 2000 -> + ct:fail({missing_timeout, Sched}) + end + end, + lists:seq(1, SchdlrsOnln)) + after + erlang:system_flag(schedulers_online, SchdlrsOnln) + end, + ok. + +multizero_timeout_in_timeout(Config) when is_list(Config) -> + Timeout = 500, + MaxTimeoutDiff = 1000, + + %% We want to operate on the same timer wheel all the time... + process_flag(scheduler, erlang:system_info(schedulers_online)), + + erlang:send_after(5*(Timeout+MaxTimeoutDiff), self(), pling), + erlang:yield(), + Start = erlang:monotonic_time(), + erts_debug:set_internal_state(multizero_timeout_in_timeout, Timeout), + receive multizero_timeout_in_timeout_done -> ok end, + End = erlang:monotonic_time(), + Time = erlang:convert_time_unit(End-Start, native, millisecond), + io:format("Time=~p~n", [Time]), + true = Time < Timeout + MaxTimeoutDiff, + ok. + + + process_is_cleaned_up(P) when is_pid(P) -> undefined == erts_debug:get_internal_state({process_status, P}). diff --git a/erts/emulator/test/z_SUITE.erl b/erts/emulator/test/z_SUITE.erl index 6549108126..590209ec36 100644 --- a/erts/emulator/test/z_SUITE.erl +++ b/erts/emulator/test/z_SUITE.erl @@ -34,28 +34,62 @@ -export([all/0, suite/0]). --export([schedulers_alive/1, node_container_refc_check/1, +-export([used_thread_specific_events/1, schedulers_alive/1, + node_container_refc_check/1, long_timers/1, pollset_size/1, check_io_debug/1, get_check_io_info/0, lc_graph/1, - leaked_processes/1]). + leaked_processes/1, + literal_area_collector/1]). suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap, {minutes, 5}}]. all() -> - [schedulers_alive, node_container_refc_check, + [used_thread_specific_events, schedulers_alive, + node_container_refc_check, long_timers, pollset_size, check_io_debug, lc_graph, %% Make sure that the leaked_processes/1 is always %% run last. - leaked_processes]. + leaked_processes, + literal_area_collector]. %%% %%% The test cases ------------------------------------------------------------- %%% +used_thread_specific_events(Config) when is_list(Config) -> + Pid = whereis(used_thread_specific_events_holder), + Mon = monitor(process, Pid), + Pid ! {get_used_tse, self()}, + UsedTSE = erlang:system_info(ethread_used_tse), + receive + {used_tse, InitialUsedTSE} -> + io:format("InitialUsedTSE=~p UsedTSE=~p~n", [InitialUsedTSE, UsedTSE]), + case os:type() of + {win32,_} -> + %% The windows poll implementation creates threads on demand + %% which in turn will get thread specific events allocated. + %% We don't know how many such threads are created, so we + %% just have to guess and test that the amount of events is + %% not huge. + Extra = 100, %% Value take out of the blue... + if UsedTSE =< InitialUsedTSE+Extra -> ok; + true -> ct:fail("An unexpected large amount of thread specific events used!") + end; + _ -> + if UsedTSE =< InitialUsedTSE -> ok; + true -> ct:fail("An increased amount of thread specific events used!") + end + end, + exit(Pid, kill), + receive {'DOWN', Mon, process, Pid, _} -> ok end; + {'DOWN', Mon, process, Pid, Reason} -> + ct:fail({used_thread_specific_events_holder, Reason}) + end. + %% Tests that all schedulers are actually used schedulers_alive(Config) when is_list(Config) -> Master = self(), @@ -323,10 +357,14 @@ leaked_processes(Config) when is_list(Config) -> [length(Leaked)])), {comment, Comment}. +literal_area_collector(Config) when is_list(Config) -> + literal_area_collector_test:check_idle(10000). + %% %% Internal functions... %% + display_check_io(ChkIo) -> catch erlang:display('--- CHECK IO INFO ---'), catch erlang:display(ChkIo), diff --git a/erts/include/internal/ethread.h b/erts/include/internal/ethread.h index fa35bf3d0b..dcdd2b3b60 100644 --- a/erts/include/internal/ethread.h +++ b/erts/include/internal/ethread.h @@ -630,12 +630,18 @@ struct ethr_ts_event_ { #define ETHR_TS_EV_INITED (((unsigned) 1) << 1) #define ETHR_TS_EV_TMP (((unsigned) 1) << 2) #define ETHR_TS_EV_MAIN_THR (((unsigned) 1) << 3) +#define ETHR_TS_EV_BUSY (((unsigned) 1) << 4) +#define ETHR_TS_EV_PEEK (((unsigned) 1) << 5) -int ethr_get_tmp_ts_event__(ethr_ts_event **tsepp); +ethr_sint64_t ethr_no_used_tse(void); int ethr_free_ts_event__(ethr_ts_event *tsep); -int ethr_make_ts_event__(ethr_ts_event **tsepp); +int ethr_make_ts_event__(ethr_ts_event **tsepp, int tmp); #if !defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHREAD_IMPL__) +ethr_ts_event *ethr_lookup_ts_event__(int busy_dup); +ethr_ts_event *ethr_peek_ts_event(void); +void ethr_unpeek_ts_event(ethr_ts_event *); +ethr_ts_event *ethr_use_ts_event(ethr_ts_event *tsep); ethr_ts_event *ethr_get_ts_event(void); void ethr_leave_ts_event(ethr_ts_event *); #endif @@ -647,11 +653,11 @@ void ethr_leave_ts_event(ethr_ts_event *); extern pthread_key_t ethr_ts_event_key__; static ETHR_INLINE ethr_ts_event * -ETHR_INLINE_FUNC_NAME_(ethr_get_ts_event)(void) +ETHR_INLINE_FUNC_NAME_(ethr_lookup_ts_event__)(int busy_dup) { ethr_ts_event *tsep = pthread_getspecific(ethr_ts_event_key__); - if (!tsep) { - int res = ethr_make_ts_event__(&tsep); + if (!tsep || (busy_dup && (tsep->iflgs & ETHR_TS_EV_BUSY))) { + int res = ethr_make_ts_event__(&tsep, 0); if (res != 0) ETHR_FATAL_ERROR__(res); ETHR_ASSERT(tsep); @@ -659,12 +665,6 @@ ETHR_INLINE_FUNC_NAME_(ethr_get_ts_event)(void) return tsep; } -static ETHR_INLINE void -ETHR_INLINE_FUNC_NAME_(ethr_leave_ts_event)(ethr_ts_event *tsep) -{ - -} - #endif #elif defined(ETHR_WIN32_THREADS) @@ -674,11 +674,11 @@ ETHR_INLINE_FUNC_NAME_(ethr_leave_ts_event)(ethr_ts_event *tsep) extern DWORD ethr_ts_event_key__; static ETHR_INLINE ethr_ts_event * -ETHR_INLINE_FUNC_NAME_(ethr_get_ts_event)(void) +ETHR_INLINE_FUNC_NAME_(ethr_lookup_ts_event__)(int busy_dup) { ethr_ts_event *tsep = TlsGetValue(ethr_ts_event_key__); - if (!tsep) { - int res = ethr_get_tmp_ts_event__(&tsep); + if (!tsep || (busy_dup && (tsep->iflgs & ETHR_TS_EV_BUSY))) { + int res = ethr_make_ts_event__(&tsep, !0); if (res != 0) ETHR_FATAL_ERROR__(res); ETHR_ASSERT(tsep); @@ -686,17 +686,68 @@ ETHR_INLINE_FUNC_NAME_(ethr_get_ts_event)(void) return tsep; } +#endif + +#endif + +#if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHREAD_IMPL__) + +static ETHR_INLINE ethr_ts_event * +ETHR_INLINE_FUNC_NAME_(ethr_get_ts_event)(void) +{ + ethr_ts_event *tsep = ethr_lookup_ts_event__(!0); + ETHR_ASSERT(!(tsep->iflgs & ETHR_TS_EV_BUSY)); + tsep->iflgs |= ETHR_TS_EV_BUSY; + return tsep; +} + +static ETHR_INLINE ethr_ts_event * +ETHR_INLINE_FUNC_NAME_(ethr_peek_ts_event)(void) +{ + ethr_ts_event *tsep = ethr_lookup_ts_event__(0); + ETHR_ASSERT(!(tsep->iflgs & ETHR_TS_EV_PEEK)); + tsep->iflgs |= ETHR_TS_EV_PEEK; + return tsep; +} + static ETHR_INLINE void -ETHR_INLINE_FUNC_NAME_(ethr_leave_ts_event)(ethr_ts_event *tsep) +ETHR_INLINE_FUNC_NAME_(ethr_unpeek_ts_event)(ethr_ts_event *tsep) { - if (tsep->iflgs & ETHR_TS_EV_TMP) { + ETHR_ASSERT(tsep->iflgs & ETHR_TS_EV_PEEK); + tsep->iflgs &= ~ETHR_TS_EV_PEEK; + if ((tsep->iflgs & (ETHR_TS_EV_TMP|ETHR_TS_EV_BUSY)) == ETHR_TS_EV_TMP) { int res = ethr_free_ts_event__(tsep); if (res != 0) ETHR_FATAL_ERROR__(res); } } -#endif +static ETHR_INLINE ethr_ts_event * +ETHR_INLINE_FUNC_NAME_(ethr_use_ts_event)(ethr_ts_event *tsep) +{ + ethr_ts_event *tmp_tsep = tsep; + if (tmp_tsep->iflgs & ETHR_TS_EV_BUSY) { + int res = ethr_make_ts_event__(&tmp_tsep, !0); + if (res != 0) + ETHR_FATAL_ERROR__(res); + ETHR_ASSERT(tmp_tsep && tsep != tmp_tsep); + } + ETHR_ASSERT(!(tmp_tsep->iflgs & ETHR_TS_EV_BUSY)); + tmp_tsep->iflgs |= ETHR_TS_EV_BUSY; + return tmp_tsep; +} + +static ETHR_INLINE void +ETHR_INLINE_FUNC_NAME_(ethr_leave_ts_event)(ethr_ts_event *tsep) +{ + ETHR_ASSERT(tsep->iflgs & ETHR_TS_EV_BUSY); + tsep->iflgs &= ~ETHR_TS_EV_BUSY; + if ((tsep->iflgs & (ETHR_TS_EV_TMP|ETHR_TS_EV_PEEK)) == ETHR_TS_EV_TMP) { + int res = ethr_free_ts_event__(tsep); + if (res != 0) + ETHR_FATAL_ERROR__(res); + } +} #endif diff --git a/erts/lib_src/common/ethr_aux.c b/erts/lib_src/common/ethr_aux.c index 7b156fe01a..d2be37cd02 100644 --- a/erts/lib_src/common/ethr_aux.c +++ b/erts/lib_src/common/ethr_aux.c @@ -292,7 +292,8 @@ ethr_late_init_common__(ethr_late_init_data *lid) res = init_ts_event_alloc(); if (res != 0) return res; - res = ethr_make_ts_event__(&tsep); + + res = ethr_make_ts_event__(&tsep, 0); if (res == 0) tsep->iflgs |= ETHR_TS_EV_ETHREAD; if (!lid) { @@ -434,8 +435,9 @@ typedef union { char align[ETHR_CACHE_LINE_ALIGN_SIZE(sizeof(ethr_ts_event))]; } ethr_aligned_ts_event; -static ethr_spinlock_t ts_ev_alloc_lock; +static ethr_mutex ts_ev_alloc_lock; static ethr_ts_event *free_ts_ev; +static ethr_sint64_t used_events; static ethr_ts_event *ts_event_pool(int size, ethr_ts_event **endpp) { @@ -464,34 +466,38 @@ static ethr_ts_event *ts_event_pool(int size, ethr_ts_event **endpp) static int init_ts_event_alloc(void) { + used_events = 0; free_ts_ev = ts_event_pool(ERTS_TS_EV_ALLOC_DEFAULT_POOL_SIZE, NULL); if (!free_ts_ev) return ENOMEM; - return ethr_spinlock_init(&ts_ev_alloc_lock); + return ethr_mutex_init(&ts_ev_alloc_lock); } static ethr_ts_event *ts_event_alloc(void) { ethr_ts_event *ts_ev; - ethr_spin_lock(&ts_ev_alloc_lock); + ethr_mutex_lock(&ts_ev_alloc_lock); + ETHR_ASSERT(used_events >= 0); if (free_ts_ev) { ts_ev = free_ts_ev; free_ts_ev = ts_ev->next; - ethr_spin_unlock(&ts_ev_alloc_lock); + used_events++; + ethr_mutex_unlock(&ts_ev_alloc_lock); } else { ethr_ts_event *ts_ev_pool_end; - ethr_spin_unlock(&ts_ev_alloc_lock); + ethr_mutex_unlock(&ts_ev_alloc_lock); ts_ev = ts_event_pool(ERTS_TS_EV_ALLOC_POOL_SIZE, &ts_ev_pool_end); if (!ts_ev) return NULL; - ethr_spin_lock(&ts_ev_alloc_lock); + ethr_mutex_lock(&ts_ev_alloc_lock); ts_ev_pool_end->next = free_ts_ev; free_ts_ev = ts_ev->next; - ethr_spin_unlock(&ts_ev_alloc_lock); + used_events++; + ethr_mutex_unlock(&ts_ev_alloc_lock); } return ts_ev; } @@ -499,69 +505,71 @@ static ethr_ts_event *ts_event_alloc(void) static void ts_event_free(ethr_ts_event *ts_ev) { ETHR_ASSERT(!ts_ev->udata); - ethr_spin_lock(&ts_ev_alloc_lock); + ethr_mutex_lock(&ts_ev_alloc_lock); + ETHR_ASSERT(used_events > 0); + used_events--; ts_ev->next = free_ts_ev; free_ts_ev = ts_ev; - ethr_spin_unlock(&ts_ev_alloc_lock); + ethr_mutex_unlock(&ts_ev_alloc_lock); } -int ethr_make_ts_event__(ethr_ts_event **tsepp) +static void +init_ts_event_flags(ethr_ts_event **tsepp) { - int res; ethr_ts_event *tsep = *tsepp; - - if (!tsep) { - tsep = ts_event_alloc(); - if (!tsep) - return ENOMEM; - } - - if ((tsep->iflgs & ETHR_TS_EV_INITED) == 0) { - res = ethr_event_init(&tsep->event); - if (res != 0) { - ts_event_free(tsep); - return res; - } - } - tsep->iflgs = ETHR_TS_EV_INITED; tsep->udata = NULL; tsep->rgix = 0; tsep->mtix = 0; +} - res = ethr_set_tse__(tsep); - if (res != 0 && tsepp && *tsepp) { - ts_event_free(tsep); - return res; - } - - if (tsepp) - *tsepp = tsep; - - return 0; +ethr_sint64_t +ethr_no_used_tse(void) +{ + ethr_sint64_t res; + ethr_mutex_lock(&ts_ev_alloc_lock); + ETHR_ASSERT(used_events >= 0); + res = used_events; + ethr_mutex_unlock(&ts_ev_alloc_lock); + return res; } -int ethr_get_tmp_ts_event__(ethr_ts_event **tsepp) + +int ethr_make_ts_event__(ethr_ts_event **tsepp, int tmp) { int res; - ethr_ts_event *tsep = *tsepp; + ethr_ts_event *tsep; - if (!tsep) { - tsep = ts_event_alloc(); - if (!tsep) - return ENOMEM; - } + tsep = ts_event_alloc(); + if (!tsep) + return ENOMEM; - if ((tsep->iflgs & ETHR_TS_EV_INITED) == 0) { - res = ethr_event_init(&tsep->event); - if (res != 0) { - ts_event_free(tsep); - return res; - } + if (*tsepp) { + *tsep = **tsepp; + ETHR_ASSERT(tsep->iflgs & ETHR_TS_EV_BUSY); + tsep->iflgs &= ~ETHR_TS_EV_BUSY; + tsep->iflgs |= ETHR_TS_EV_TMP; } + else { + init_ts_event_flags(&tsep); - tsep->iflgs = ETHR_TS_EV_INITED|ETHR_TS_EV_TMP; - tsep->udata = NULL; + if (tmp) { + tsep->iflgs |= ETHR_TS_EV_TMP; + } + else { + res = ethr_set_tse__(tsep); + if (res != 0 && tsepp && *tsepp) { + ts_event_free(tsep); + return res; + } + } + } + + res = ethr_event_init(&tsep->event); + if (res != 0) { + ts_event_free(tsep); + return res; + } if (tsepp) *tsepp = tsep; @@ -571,8 +579,10 @@ int ethr_get_tmp_ts_event__(ethr_ts_event **tsepp) int ethr_free_ts_event__(ethr_ts_event *tsep) { - ts_event_free(tsep); - return 0; + int res = ethr_event_destroy(&tsep->event); + if (res == 0) + ts_event_free(tsep); + return res; } void ethr_ts_event_destructor__(void *vtsep) diff --git a/erts/lib_src/common/ethr_mutex.c b/erts/lib_src/common/ethr_mutex.c index 5e7e7b2f32..7be83b9117 100644 --- a/erts/lib_src/common/ethr_mutex.c +++ b/erts/lib_src/common/ethr_mutex.c @@ -184,7 +184,7 @@ ethr_rwmutex_set_reader_group(int ix) tse = ethr_get_ts_event(); - if ((tse->iflgs & ETHR_TS_EV_ETHREAD) == 0) { + if ((tse->iflgs & (ETHR_TS_EV_ETHREAD|ETHR_TS_EV_TMP)) == 0) { ethr_leave_ts_event(tse); return EINVAL; } @@ -419,6 +419,8 @@ event_wait(struct ethr_mutex_base_ *mtxb, int need_try_complete_runlock = 0; int transfer_read_lock = 0; + ETHR_ASSERT(tse->iflgs & ETHR_TS_EV_BUSY); + /* Need to enqueue and wait... */ tse->uflgs = type; @@ -683,7 +685,7 @@ write_lock_wait(struct ethr_mutex_base_ *mtxb, ethr_rwmutex *rwmtx = (ethr_rwmutex *) mtxb; scnt--; if (!tse) - tse = ethr_get_ts_event(); + tse = ethr_peek_ts_event(); res = rwmutex_try_complete_runlock(rwmtx, act, tse, 0, 0, 1); @@ -702,10 +704,12 @@ write_lock_wait(struct ethr_mutex_base_ *mtxb, scnt = 0; if (!tse) - tse = ethr_get_ts_event(); + tse = ethr_peek_ts_event(); if (update_spincount(mtxb, tse, &start_scnt, &scnt)) { - event_wait(mtxb, tse, scnt, ETHR_RWMTX_W_WAIT_FLG__, + ethr_ts_event *tmp_tse = ethr_use_ts_event(tse); + event_wait(mtxb, tmp_tse, scnt, ETHR_RWMTX_W_WAIT_FLG__, is_rwmtx, is_freq_read); + ethr_leave_ts_event(tmp_tse); goto done; } } @@ -727,7 +731,7 @@ write_lock_wait(struct ethr_mutex_base_ *mtxb, done: if (tse) - ethr_leave_ts_event(tse); + ethr_unpeek_ts_event(tse); } static int @@ -1236,6 +1240,7 @@ ethr_cond_wait(ethr_cond *cnd, ethr_mutex *mtx) } ETHR_ASSERT(act == ETHR_RWMTX_W_WAIT_FLG__); } + ETHR_ASSERT(tse->iflgs & ETHR_TS_EV_BUSY); ethr_event_swait(&tse->event, scnt); /* swait result: 0 || EINTR */ woken = 1; @@ -1976,7 +1981,7 @@ rwmutex_try_complete_runlock(ethr_rwmutex *rwmtx, tse_tmp = tse; if (!tse_tmp) - tse_tmp = ethr_get_ts_event(); + tse_tmp = ethr_peek_ts_event(); if ((act & ETHR_RWMTX_WAIT_FLGS__) && (act & ~ETHR_RWMTX_WAIT_FLGS__) == 0) goto check_waiters; @@ -1996,7 +2001,7 @@ rwmutex_try_complete_runlock(ethr_rwmutex *rwmtx, } if (!tse) - ethr_leave_ts_event(tse_tmp); + ethr_unpeek_ts_event(tse_tmp); if (check_before_try) { res = check_readers_array(rwmtx, six, length); @@ -2135,7 +2140,7 @@ rwmutex_normal_rlock_wait(ethr_rwmutex *rwmtx, ethr_sint32_t initial) { ethr_sint32_t act = initial, exp; int scnt, start_scnt; - ethr_ts_event *tse = NULL; + ethr_ts_event *tse = ethr_get_ts_event(); int until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS; start_scnt = scnt = initial_spincount(&rwmtx->mtxb); @@ -2154,7 +2159,6 @@ rwmutex_normal_rlock_wait(ethr_rwmutex *rwmtx, ethr_sint32_t initial) while (act & (ETHR_RWMTX_W_FLG__|ETHR_RWMTX_W_WAIT_FLG__)) { if (scnt <= 0) { - tse = ethr_get_ts_event(); if (update_spincount(&rwmtx->mtxb, tse, &start_scnt, &scnt)) { event_wait(&rwmtx->mtxb, tse, scnt, ETHR_RWMTX_R_WAIT_FLG__, 1, 0); @@ -2183,8 +2187,7 @@ rwmutex_normal_rlock_wait(ethr_rwmutex *rwmtx, ethr_sint32_t initial) } done: - if (tse) - ethr_leave_ts_event(tse); + ethr_leave_ts_event(tse); } static void @@ -2283,8 +2286,10 @@ rwmutex_freqread_rlock_wait(ethr_rwmutex *rwmtx, while (act & (ETHR_RWMTX_W_FLG__|ETHR_RWMTX_W_WAIT_FLG__)) { if (scnt <= 0) { if (update_spincount(&rwmtx->mtxb, tse, &start_scnt, &scnt)) { - event_wait(&rwmtx->mtxb, tse, scnt, + ethr_ts_event *tmp_tse = ethr_use_ts_event(tse); + event_wait(&rwmtx->mtxb, tmp_tse, scnt, ETHR_RWMTX_R_WAIT_FLG__, 1, 1); + ethr_leave_ts_event(tmp_tse); return; /* Got it */ } } @@ -2799,9 +2804,9 @@ ethr_rwmutex_tryrlock(ethr_rwmutex *rwmtx) case ETHR_RWMUTEX_TYPE_FREQUENT_READ: case ETHR_RWMUTEX_TYPE_EXTREMELY_FREQUENT_READ: { - ethr_ts_event *tse = ethr_get_ts_event(); + ethr_ts_event *tse = ethr_peek_ts_event(); res = rwmutex_freqread_rlock(rwmtx, tse, 1); - ethr_leave_ts_event(tse); + ethr_unpeek_ts_event(tse); break; } } @@ -2859,9 +2864,9 @@ ethr_rwmutex_rlock(ethr_rwmutex *rwmtx) case ETHR_RWMUTEX_TYPE_FREQUENT_READ: case ETHR_RWMUTEX_TYPE_EXTREMELY_FREQUENT_READ: { - ethr_ts_event *tse = ethr_get_ts_event(); + ethr_ts_event *tse = ethr_peek_ts_event(); rwmutex_freqread_rlock(rwmtx, tse, 0); - ethr_leave_ts_event(tse); + ethr_unpeek_ts_event(tse); break; } } @@ -2901,7 +2906,7 @@ ethr_rwmutex_runlock(ethr_rwmutex *rwmtx) case ETHR_RWMUTEX_TYPE_FREQUENT_READ: case ETHR_RWMUTEX_TYPE_EXTREMELY_FREQUENT_READ: { - ethr_ts_event *tse = ethr_get_ts_event(); + ethr_ts_event *tse = ethr_peek_ts_event(); act = rwmutex_freqread_rdrs_dec_read_relb(rwmtx, tse); @@ -2915,7 +2920,7 @@ ethr_rwmutex_runlock(ethr_rwmutex *rwmtx) rwmutex_freqread_rdrs_dec_chk_wakeup(rwmtx, tse, act); } - ethr_leave_ts_event(tse); + ethr_unpeek_ts_event(tse); break; } } diff --git a/erts/lib_src/pthread/ethr_event.c b/erts/lib_src/pthread/ethr_event.c index 464875570a..9d6e26fd81 100644 --- a/erts/lib_src/pthread/ethr_event.c +++ b/erts/lib_src/pthread/ethr_event.c @@ -361,7 +361,7 @@ wait__(ethr_event *e, int spincount, ethr_sint64_t timeout) if (spincount == 0) goto set_event_off_waiter; } - if (timeout == 0) + else if (timeout == 0) return ETIMEDOUT; else { #ifdef ETHR_HAVE_ETHR_GET_MONOTONIC_TIME diff --git a/erts/lib_src/pthread/ethread.c b/erts/lib_src/pthread/ethread.c index b4b12fcd86..cb4a5ff964 100644 --- a/erts/lib_src/pthread/ethread.c +++ b/erts/lib_src/pthread/ethread.c @@ -98,7 +98,7 @@ static void *thr_wrapper(void *vtwd) ethr_set_stacklimit__(&c, twd->stacksize); - result = (ethr_sint32_t) ethr_make_ts_event__(&tsep); + result = (ethr_sint32_t) ethr_make_ts_event__(&tsep, 0); if (result == 0) { tsep->iflgs |= ETHR_TS_EV_ETHREAD; @@ -331,7 +331,6 @@ ethr_thr_create(ethr_tid *tid, void * (*func)(void *), void *arg, #endif ethr_atomic32_init(&twd.result, (ethr_sint32_t) -1); - twd.tse = ethr_get_ts_event(); twd.thr_func = func; twd.arg = arg; twd.stacksize = 0; @@ -346,6 +345,8 @@ ethr_thr_create(ethr_tid *tid, void * (*func)(void *), void *arg, if (res != 0) return res; + twd.tse = ethr_get_ts_event(); + /* Error cleanup needed after this point */ /* Schedule child thread in system scope (if possible) ... */ @@ -426,6 +427,7 @@ ethr_thr_create(ethr_tid *tid, void * (*func)(void *), void *arg, /* Cleanup... */ error: + ethr_leave_ts_event(twd.tse); dres = pthread_attr_destroy(&attr); if (res == 0) res = dres; @@ -507,12 +509,35 @@ ethr_equal_tids(ethr_tid tid1, ethr_tid tid2) return pthread_equal((pthread_t) tid1, (pthread_t) tid2); } - /* * Thread specific events */ ethr_ts_event * +ethr_lookup_ts_event__(int busy_dup) +{ + return ethr_lookup_ts_event____(busy_dup); +} + +ethr_ts_event * +ethr_peek_ts_event(void) +{ + return ethr_peek_ts_event__(); +} + +void +ethr_unpeek_ts_event(ethr_ts_event *tsep) +{ + ethr_unpeek_ts_event__(tsep); +} + +ethr_ts_event * +ethr_use_ts_event(ethr_ts_event *tsep) +{ + return ethr_use_ts_event__(tsep); +} + +ethr_ts_event * ethr_get_ts_event(void) { return ethr_get_ts_event__(); diff --git a/erts/lib_src/win/ethread.c b/erts/lib_src/win/ethread.c index aa43e03435..dbe7ae6f44 100644 --- a/erts/lib_src/win/ethread.c +++ b/erts/lib_src/win/ethread.c @@ -106,7 +106,7 @@ static unsigned __stdcall thr_wrapper(LPVOID vtwd) ethr_set_stacklimit__(&c, twd->stacksize); - result = (ethr_sint32_t) ethr_make_ts_event__(&tsep); + result = (ethr_sint32_t) ethr_make_ts_event__(&tsep, 0); if (result == 0) { tsep->iflgs |= ETHR_TS_EV_ETHREAD; @@ -607,6 +607,30 @@ ethr_tsd_get(ethr_tsd_key key) */ ethr_ts_event * +ethr_lookup_ts_event__(int busy_dup) +{ + return ethr_lookup_ts_event____(busy_dup); +} + +ethr_ts_event * +ethr_peek_ts_event(void) +{ + return ethr_peek_ts_event__(); +} + +void +ethr_unpeek_ts_event(ethr_ts_event *tsep) +{ + ethr_unpeek_ts_event__(tsep); +} + +ethr_ts_event * +ethr_use_ts_event(ethr_ts_event *tsep) +{ + return ethr_use_ts_event__(tsep); +} + +ethr_ts_event * ethr_get_ts_event(void) { return ethr_get_ts_event__(); @@ -618,10 +642,3 @@ ethr_leave_ts_event(ethr_ts_event *tsep) ethr_leave_ts_event__(tsep); } -ethr_ts_event * -ethr_create_ts_event__(void) -{ - ethr_ts_event *tsep; - ethr_make_ts_event__(&tsep); - return tsep; -} diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex 03b79f0fa8..38cf2378ab 100644 --- a/erts/preloaded/ebin/erts_internal.beam +++ b/erts/preloaded/ebin/erts_internal.beam diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam Binary files differindex d3614d5f16..8833f9c77c 100644 --- a/erts/preloaded/ebin/prim_inet.beam +++ b/erts/preloaded/ebin/prim_inet.beam diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index 57015a64c8..482fb5c907 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -47,7 +47,8 @@ -export([is_process_executing_dirty/1]). -export([dirty_process_handle_signals/1]). --export([release_literal_area_switch/0]). +-export([release_literal_area_switch/0, wait_release_literal_area_switch/1]). + -export([purge_module/2]). -export([flush_monitor_messages/3]). @@ -340,6 +341,15 @@ dirty_process_handle_signals(_Pid) -> release_literal_area_switch() -> erlang:nif_error(undefined). +-spec wait_release_literal_area_switch(WaitMsg) -> 'true' | 'false' when + WaitMsg :: term(). + +wait_release_literal_area_switch(WaitMsg) -> + %% release_literal_area_switch() traps to here + %% when it needs to wait + receive WaitMsg -> ok end, + erts_internal:release_literal_area_switch(). + -spec purge_module(Module, Op) -> boolean() when Module :: module(), Op :: 'prepare' | 'prepare_on_load' | 'abort' | 'complete'. diff --git a/erts/preloaded/src/prim_inet.erl b/erts/preloaded/src/prim_inet.erl index 2820a5bef4..77d4292ad0 100644 --- a/erts/preloaded/src/prim_inet.erl +++ b/erts/preloaded/src/prim_inet.erl @@ -553,34 +553,49 @@ send(S, Data) -> %% "sendto" is for UDP. IP and Port are set by the caller to 0 if the socket %% is known to be connected. -sendto(S, Addr, _, Data) when is_port(S), tuple_size(Addr) =:= 2 -> - case type_value(set, addr, Addr) of - true -> - ?DBG_FORMAT("prim_inet:sendto(~p, ~p, ~p)~n", [S,Addr,Data]), - try - erlang:port_command(S, [enc_value(set, addr, Addr),Data]) - of - true -> - receive - {inet_reply,S,Reply} -> - ?DBG_FORMAT( - "prim_inet:sendto() -> ~p~n", [Reply]), - Reply - end - catch - error:_ -> - ?DBG_FORMAT( - "prim_inet:sendto() -> {error,einval}~n", []), - {error,einval} - end; - false -> - ?DBG_FORMAT( - "prim_inet:sendto() -> {error,einval}~n", []), - {error,einval} - end; -sendto(S, IP, Port, Data) -> - sendto(S, {IP, Port}, 0, Data). - +sendto(S, {_, _} = Address, AncOpts, Data) + when is_port(S), is_list(AncOpts) -> + case encode_opt_val(AncOpts) of + {ok, AncData} -> + AncDataLen = iolist_size(AncData), + case + type_value(set, addr, Address) andalso + type_value(set, uint32, AncDataLen) + of + true -> + ?DBG_FORMAT("prim_inet:sendto(~p, ~p, ~p, ~p)~n", + [S,Address,AncOpts,Data]), + PortCommandData = + [enc_value(set, addr, Address), + enc_value(set, uint32, AncDataLen), AncData, + Data], + try erlang:port_command(S, PortCommandData) of + true -> + receive + {inet_reply,S,Reply} -> + ?DBG_FORMAT( + "prim_inet:sendto() -> ~p~n", [Reply]), + Reply + end + catch + _:_ -> + ?DBG_FORMAT( + "prim_inet:sendto() -> {error,einval}~n", []), + {error,einval} + end; + false -> + ?DBG_FORMAT( + "prim_inet:sendto() -> {error,einval}~n", []), + {error,einval} + end; + {error,_} -> + ?DBG_FORMAT( + "prim_inet:sendto() -> {error,einval}~n", []), + {error,einval} + end; +sendto(S, IP, Port, Data) + when is_port(S), is_integer(Port) -> + sendto(S, {IP, Port}, [], Data). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% @@ -1993,15 +2008,15 @@ enc_value_2(addr, {File,_}) when is_list(File); is_binary(File) -> [?INET_AF_LOCAL,iolist_size(File)|File]; %% enc_value_2(addr, {inet,{any,Port}}) -> - [?INET_AF_INET,?int16(Port),0,0,0,0]; + [?INET_AF_INET,?int16(Port)|ip4_to_bytes({0,0,0,0})]; enc_value_2(addr, {inet,{loopback,Port}}) -> - [?INET_AF_INET,?int16(Port),127,0,0,1]; + [?INET_AF_INET,?int16(Port)|ip4_to_bytes({127,0,0,1})]; enc_value_2(addr, {inet,{IP,Port}}) -> [?INET_AF_INET,?int16(Port)|ip4_to_bytes(IP)]; enc_value_2(addr, {inet6,{any,Port}}) -> - [?INET_AF_INET6,?int16(Port),0,0,0,0,0,0,0,0]; + [?INET_AF_INET6,?int16(Port)|ip6_to_bytes({0,0,0,0,0,0,0,0})]; enc_value_2(addr, {inet6,{loopback,Port}}) -> - [?INET_AF_INET6,?int16(Port),0,0,0,0,0,0,0,1]; + [?INET_AF_INET6,?int16(Port)|ip6_to_bytes({0,0,0,0,0,0,0,1})]; enc_value_2(addr, {inet6,{IP,Port}}) -> [?INET_AF_INET6,?int16(Port)|ip6_to_bytes(IP)]; enc_value_2(addr, {local,Addr}) -> @@ -2149,10 +2164,10 @@ enum_name(_, []) -> false. %% encode opt/val REVERSED since options are stored in reverse order %% i.e. the recent options first (we must process old -> new) encode_opt_val(Opts) -> - try - enc_opt_val(Opts, []) + try + {ok, enc_opt_val(Opts, [])} catch - Reason -> {error,Reason} + throw:Reason -> {error,Reason} end. %% {active, once} and {active, N} are specially optimized because they will @@ -2171,17 +2186,21 @@ enc_opt_val([binary|Opts], Acc) -> enc_opt_val(Opts, Acc, mode, binary); enc_opt_val([list|Opts], Acc) -> enc_opt_val(Opts, Acc, mode, list); -enc_opt_val([_|_], _) -> {error,einval}; -enc_opt_val([], Acc) -> {ok,Acc}. +enc_opt_val([_|_], _) -> + throw(einval); +enc_opt_val([], Acc) -> + Acc. enc_opt_val(Opts, Acc, Opt, Val) when is_atom(Opt) -> Type = type_opt(set, Opt), case type_value(set, Type, Val) of true -> enc_opt_val(Opts, [enc_opt(Opt),enc_value(set, Type, Val)|Acc]); - false -> {error,einval} + false -> + throw(einval) end; -enc_opt_val(_, _, _, _) -> {error,einval}. +enc_opt_val(_, _, _, _) -> + throw(einval). diff --git a/erts/vsn.mk b/erts/vsn.mk index c57f8746f6..ac852b78eb 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% # -VSN = 10.3.5 +VSN = 10.3.5.18 # Port number 4365 in 4.2 # Port number 4366 in 4.3 diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index 9c74146d73..7cf043eccd 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -33,6 +33,37 @@ <file>notes.xml</file> </header> +<section><title>Common_Test 1.17.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + If a ct hook is installed in the <c>suite/0</c> function + in a test suite, then the hook's <c>terminate/1</c> + function would be called several times without it's + <c>init/2</c> function being called first. This is now + corrected.</p> + <p> + Own Id: OTP-15863 Aux Id: ERIERL-370 </p> + </item> + <item> + <p> + If <c>init_per_testcase</c> fails, the test itself is + skipped. According to the documentation, it should be + possible to change the result to failed in a hook + function. The only available hook function in this case + is <c>post_init_per_testcase</c>, but changing the return + value there did not affect the test case result. This is + now corrected.</p> + <p> + Own Id: OTP-15869 Aux Id: ERIERL-350 </p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.17.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl index 97c349578f..94551d6815 100644 --- a/lib/common_test/src/ct_hooks.erl +++ b/lib/common_test/src/ct_hooks.erl @@ -363,7 +363,16 @@ terminate_if_scope_ends(HookId, Function0, Hooks) -> Function = strip_config(Function0), case lists:keyfind(HookId, #ct_hook_config.id, Hooks) of #ct_hook_config{ id = HookId, scope = Function} = Hook -> - terminate([Hook]), + case Function of + [AllOrGroup,_] when AllOrGroup=:=post_all; + AllOrGroup=:=post_groups -> + %% The scope only contains one function (post_all + %% or post_groups), and init has not been called, + %% so skip terminate as well. + ok; + _ -> + terminate([Hook]) + end, lists:keydelete(HookId, #ct_hook_config.id, Hooks); _ -> Hooks diff --git a/lib/common_test/src/test_server.erl b/lib/common_test/src/test_server.erl index 756cd4d692..588396f101 100644 --- a/lib/common_test/src/test_server.erl +++ b/lib/common_test/src/test_server.erl @@ -1364,23 +1364,29 @@ do_end_tc_call(Mod, IPTC={init_per_testcase,Func}, Res, Return) -> {NOk,_} when NOk == auto_skip; NOk == fail; NOk == skip ; NOk == skipped -> {_,Args} = Res, - IPTCEndRes = + {NewConfig,IPTCEndRes} = case do_end_tc_call1(Mod, IPTC, Res, Return) of IPTCEndConfig when is_list(IPTCEndConfig) -> - IPTCEndConfig; + {IPTCEndConfig,IPTCEndConfig}; + {failed,RetReason} when Return=:={fail,RetReason} -> + %% Fail reason not changed by framework or hook + {Args,Return}; + {SF,_} = IPTCEndResult when SF=:=skip; SF=:=skipped; + SF=:=fail; SF=:=failed -> + {Args,IPTCEndResult}; _ -> - Args + {Args,Return} end, EPTCInitRes = case do_init_tc_call(Mod,{end_per_testcase_not_run,Func}, - IPTCEndRes,Return) of + NewConfig,IPTCEndRes) of {ok,EPTCInitConfig} when is_list(EPTCInitConfig) -> - {Return,EPTCInitConfig}; + {IPTCEndRes,EPTCInitConfig}; _ -> - {Return,IPTCEndRes} + {IPTCEndRes,NewConfig} end, do_end_tc_call1(Mod, {end_per_testcase_not_run,Func}, - EPTCInitRes, Return); + EPTCInitRes, IPTCEndRes); _Ok -> do_end_tc_call1(Mod, IPTC, Res, Return) end; diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl index 340b8f3d52..b87464f5e4 100644 --- a/lib/common_test/test/ct_hooks_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE.erl @@ -86,7 +86,7 @@ all(suite) -> scope_suite_state_cth, fail_pre_suite_cth, double_fail_pre_suite_cth, fail_post_suite_cth, skip_pre_suite_cth, skip_pre_end_cth, - skip_pre_init_tc_cth, + skip_pre_init_tc_cth, fail_post_init_tc_cth, skip_post_suite_cth, recover_post_suite_cth, update_config_cth, state_update_cth, update_result_cth, options_cth, same_id_cth, fail_n_skip_with_minimal_cth, prio_cth, no_config, @@ -206,6 +206,10 @@ skip_pre_init_tc_cth(Config) -> do_test(skip_pre_init_tc_cth, "ct_cth_empty_SUITE.erl", [skip_pre_init_tc_cth],Config). +fail_post_init_tc_cth(Config) -> + do_test(fail_post_init_tc_cth, "ct_fail_init_tc_SUITE.erl", + [fail_post_init_tc_cth],Config). + recover_post_suite_cth(Config) when is_list(Config) -> do_test(recover_post_suite_cth, "ct_cth_fail_per_suite_SUITE.erl", [recover_post_suite_cth],Config). @@ -671,9 +675,15 @@ test_events(scope_suite_cth) -> {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, %% check that post_groups and post_all comes before init when hook %% is installed in suite/0 + %% And there should be no terminate after these, since init is + %% not yet called. {?eh,cth,{'_',post_groups,['_',[]]}}, - {?eh,cth,{'_',post_all,['_','_',[]]}}, - {?eh,tc_start,{ct_scope_suite_cth_SUITE,init_per_suite}}, + {negative, + {?eh,cth,{'_',terminate,['_']}}, + {?eh,cth,{'_',post_all,['_','_',[]]}}}, + {negative, + {?eh,cth,{'_',terminate,['_']}}, + {?eh,tc_start,{ct_scope_suite_cth_SUITE,init_per_suite}}}, {?eh,cth,{'_',id,[[]]}}, {?eh,cth,{'_',init,['_',[]]}}, {?eh,cth,{'_',pre_init_per_suite,[ct_scope_suite_cth_SUITE,'$proplist',[]]}}, @@ -1036,6 +1046,44 @@ test_events(skip_pre_init_tc_cth) -> {?eh,stop_logging,[]} ]; +test_events(fail_post_init_tc_cth) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,init,['_',[]]}}, + {?eh,start_info,{1,1,1}}, + {?eh,tc_start,{ct_fail_init_tc_SUITE,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite,[ct_fail_init_tc_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [ct_fail_init_tc_SUITE,'$proplist','$proplist',[]]}}, + {?eh,tc_done,{ct_fail_init_tc_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{ct_fail_init_tc_SUITE,test_case}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [ct_fail_init_tc_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [ct_fail_init_tc_SUITE,test_case,'$proplist', + {skip, + {failed, + {ct_fail_init_tc_SUITE,init_per_testcase, + {{test_case_failed,"Failed in init_per_testcase"},'_'}}}}, + []]}}, + {?eh,tc_done,{ct_fail_init_tc_SUITE,test_case, + {failed,"Changed skip to fail in post_init_per_testcase"}}}, + {?eh,cth,{empty_cth,on_tc_fail, + [ct_fail_init_tc_SUITE,test_case, + "Changed skip to fail in post_init_per_testcase", + []]}}, + {?eh,test_stats,{0,1,{0,0}}}, + {?eh,tc_start,{ct_fail_init_tc_SUITE,end_per_suite}}, + {?eh,cth,{empty_cth,pre_end_per_suite,[ct_fail_init_tc_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_suite, + [ct_fail_init_tc_SUITE,'$proplist',ok,[]]}}, + {?eh,tc_done,{ct_fail_init_tc_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + test_events(recover_post_suite_cth) -> Suite = ct_cth_fail_per_suite_SUITE, [ diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_fail_init_tc_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_fail_init_tc_SUITE.erl new file mode 100644 index 0000000000..96ddfc5782 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_fail_init_tc_SUITE.erl @@ -0,0 +1,49 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(ct_fail_init_tc_SUITE). + +-suite_defaults([{timetrap, {minutes, 10}}]). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include("ct.hrl"). + +%% Test server callback functions +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(TestCase, _Config) -> + ct:fail("Failed in init_per_testcase"). + +end_per_testcase(_TestCase, _Config) -> + ok. + +all() -> + [test_case]. + +%% Test cases starts here. +test_case(Config) when is_list(Config) -> + ok. + diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_init_tc_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_init_tc_cth.erl new file mode 100644 index 0000000000..ca9f05c40f --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_init_tc_cth.erl @@ -0,0 +1,81 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + + +-module(fail_post_init_tc_cth). + + +-include_lib("common_test/src/ct_util.hrl"). +-include_lib("common_test/include/ct_event.hrl"). + + +%% CT Hooks +-compile(export_all). + +init(Id, Opts) -> + empty_cth:init(Id, Opts). + +pre_init_per_suite(Suite, Config, State) -> + empty_cth:pre_init_per_suite(Suite,Config,State). + +post_init_per_suite(Suite,Config,Return,State) -> + empty_cth:post_init_per_suite(Suite,Config,Return,State). + +pre_end_per_suite(Suite,Config,State) -> + empty_cth:pre_end_per_suite(Suite,Config,State). + +post_end_per_suite(Suite,Config,Return,State) -> + empty_cth:post_end_per_suite(Suite,Config,Return,State). + +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). + +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). + +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State). + +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). + +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). + +post_init_per_testcase(Suite,TC,Config,{skip,_}=Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State), + {{fail,"Changed skip to fail in post_init_per_testcase"},State}; +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). + +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). + +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). + +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). + +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). + +terminate(State) -> + empty_cth:terminate(State). diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index 73a442a29c..138387173d 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.17.2 +COMMON_TEST_VSN = 1.17.2.1 diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 194a3d30e9..6377a1ee63 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -524,8 +524,6 @@ static ERL_NIF_TERM hmac_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM static ERL_NIF_TERM hmac_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM cmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM aes_cfb_128_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -718,8 +716,6 @@ static ERL_NIF_TERM atom_ppbasis; static ERL_NIF_TERM atom_onbasis; #endif -static ERL_NIF_TERM atom_aes_cfb8; -static ERL_NIF_TERM atom_aes_cfb128; #ifdef HAVE_GCM static ERL_NIF_TERM atom_aes_gcm; #endif @@ -942,8 +938,12 @@ static struct cipher_type_t cipher_types[] = {{"aes_cbc"}, {&EVP_aes_256_cbc}, 32}, {{"aes_cbc128"}, {&EVP_aes_128_cbc}}, {{"aes_cbc256"}, {&EVP_aes_256_cbc}}, - {{"aes_cfb8"}, {&EVP_aes_128_cfb8}}, - {{"aes_cfb128"}, {&EVP_aes_128_cfb128}}, + {{"aes_cfb8"}, {&EVP_aes_128_cfb8}, 16}, + {{"aes_cfb8"}, {&EVP_aes_192_cfb8}, 24}, + {{"aes_cfb8"}, {&EVP_aes_256_cfb8}, 32}, + {{"aes_cfb128"}, {&EVP_aes_128_cfb128}, 16}, + {{"aes_cfb128"}, {&EVP_aes_192_cfb128}, 24}, + {{"aes_cfb128"}, {&EVP_aes_256_cfb128}, 32}, {{"aes_ecb"}, {&EVP_aes_128_ecb}, 16}, {{"aes_ecb"}, {&EVP_aes_192_ecb}, 24}, {{"aes_ecb"}, {&EVP_aes_256_ecb}, 32}, @@ -1174,8 +1174,6 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) atom_onbasis = enif_make_atom(env,"onbasis"); #endif - atom_aes_cfb8 = enif_make_atom(env, "aes_cfb8"); - atom_aes_cfb128 = enif_make_atom(env, "aes_cfb128"); #ifdef HAVE_GCM atom_aes_gcm = enif_make_atom(env, "aes_gcm"); #endif @@ -1427,6 +1425,8 @@ static void init_algorithms_types(ErlNifEnv* env) algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cbc"); algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cbc128"); algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cbc256"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cfb8"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cfb128"); algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_ctr"); algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_ecb"); #if defined(HAVE_GCM) @@ -1440,8 +1440,6 @@ static void init_algorithms_types(ErlNifEnv* env) #ifdef HAVE_AES_IGE algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"aes_ige256"); #endif - algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cfb8"); - algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cfb128"); #ifndef OPENSSL_NO_DES algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"des_cbc"); algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"des_cfb"); @@ -2325,25 +2323,6 @@ static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM if (!cipher) { return enif_raise_exception(env, atom_notsup); } - - if (argv[0] == atom_aes_cfb8) { - CHECK_NO_FIPS_MODE(); - if ((key.size == 24 || key.size == 32)) { - /* Why do EVP_CIPHER_CTX_set_key_length() fail on these key sizes? - * Fall back on low level API - */ - return aes_cfb_8_crypt(env, argc-1, argv+1); - } - } - else if (argv[0] == atom_aes_cfb128) { - CHECK_NO_FIPS_MODE(); - if ((key.size == 24 || key.size == 32)) { - /* Why do EVP_CIPHER_CTX_set_key_length() fail on these key sizes? - * Fall back on low level API - */ - return aes_cfb_128_crypt_nif(env, argc-1, argv+1); - } - } ivec_size = EVP_CIPHER_iv_length(cipher); #ifdef HAVE_ECB_IVEC_BUG @@ -2391,58 +2370,6 @@ static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM return ret; } -static ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, IVec, Data, IsEncrypt) */ - ErlNifBinary key, ivec, text; - AES_KEY aes_key; - unsigned char ivec_clone[16]; /* writable copy */ - int new_ivlen = 0; - ERL_NIF_TERM ret; - - CHECK_NO_FIPS_MODE(); - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) - || !(key.size == 16 || key.size == 24 || key.size == 32) - || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 - || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { - return enif_make_badarg(env); - } - - memcpy(ivec_clone, ivec.data, 16); - AES_set_encrypt_key(key.data, key.size * 8, &aes_key); - AES_cfb8_encrypt((unsigned char *) text.data, - enif_make_new_binary(env, text.size, &ret), - text.size, &aes_key, ivec_clone, &new_ivlen, - (argv[3] == atom_true)); - CONSUME_REDS(env,text); - return ret; -} - -static ERL_NIF_TERM aes_cfb_128_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, IVec, Data, IsEncrypt) */ - ErlNifBinary key, ivec, text; - AES_KEY aes_key; - unsigned char ivec_clone[16]; /* writable copy */ - int new_ivlen = 0; - ERL_NIF_TERM ret; - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) - || !(key.size == 16 || key.size == 24 || key.size == 32) - || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 - || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { - return enif_make_badarg(env); - } - - memcpy(ivec_clone, ivec.data, 16); - AES_set_encrypt_key(key.data, key.size * 8, &aes_key); - AES_cfb128_encrypt((unsigned char *) text.data, - enif_make_new_binary(env, text.size, &ret), - text.size, &aes_key, ivec_clone, &new_ivlen, - (argv[3] == atom_true)); - CONSUME_REDS(env,text); - return ret; -} - static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key, IVec, Data, IsEncrypt) */ #ifdef HAVE_AES_IGE @@ -3662,6 +3589,7 @@ static ERL_NIF_TERM srp_value_B_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM BN_mod_mul(bn_multiplier, bn_multiplier, bn_verifier, bn_prime, bn_ctx); /* g^b % N */ + BN_set_flags(bn_exponent, BN_FLG_CONSTTIME); BN_mod_exp(bn_result, bn_generator, bn_exponent, bn_prime, bn_ctx); /* k*v + g^b % N */ @@ -3739,6 +3667,7 @@ static ERL_NIF_TERM srp_user_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_ /* (B - (k * g^x)) */ bn_base = BN_new(); + BN_set_flags(bn_exponent, BN_FLG_CONSTTIME); BN_mod_exp(bn_result, bn_generator, bn_exponent, bn_prime, bn_ctx); BN_mod_mul(bn_result, bn_multiplier, bn_result, bn_prime, bn_ctx); BN_mod_sub(bn_base, bn_B, bn_result, bn_prime, bn_ctx); @@ -3749,6 +3678,7 @@ static ERL_NIF_TERM srp_user_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_ BN_add(bn_exp2, bn_a, bn_result); /* (B - (k * g^x)) ^ (a + (u * x)) % N */ + BN_set_flags(bn_exp2, BN_FLG_CONSTTIME); BN_mod_exp(bn_result, bn_base, bn_exp2, bn_prime, bn_ctx); dlen = BN_num_bytes(bn_result); @@ -3814,10 +3744,12 @@ static ERL_NIF_TERM srp_host_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_ /* (A * v^u) */ bn_base = BN_new(); + BN_set_flags(bn_u, BN_FLG_CONSTTIME); BN_mod_exp(bn_base, bn_verifier, bn_u, bn_prime, bn_ctx); BN_mod_mul(bn_base, bn_A, bn_base, bn_prime, bn_ctx); /* (A * v^u) ^ b % N */ + BN_set_flags(bn_b, BN_FLG_CONSTTIME); BN_mod_exp(bn_result, bn_base, bn_b, bn_prime, bn_ctx); dlen = BN_num_bytes(bn_result); diff --git a/lib/crypto/doc/src/notes.xml b/lib/crypto/doc/src/notes.xml index 195c9d029d..3b20407132 100644 --- a/lib/crypto/doc/src/notes.xml +++ b/lib/crypto/doc/src/notes.xml @@ -31,6 +31,60 @@ </header> <p>This document describes the changes made to the Crypto application.</p> +<section><title>Crypto 4.4.2.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Adding missing flag in BN-calls in SRP.</p> + <p> + Own Id: OTP-17107</p> + </item> + </list> + </section> + +</section> + +<section><title>Crypto 4.4.2.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Constant time comparisons added.</p> + <p> + Own Id: OTP-16376</p> + </item> + </list> + </section> + +</section> + +<section><title>Crypto 4.4.2.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The chipers aes_cfb8 and aes_cfb128 are now using the EVP + interface. The supported key lengths are 128, 192 and 256 + bits.</p> + <p> + Own Id: OTP-16133 Aux Id: PR-2407 </p> + </item> + <item> + <p> + The chipers aes_cfb8 and aes_cfb128 are now available in + FIPS enabled mode.</p> + <p> + Own Id: OTP-16134 Aux Id: PR-2407 </p> + </item> + </list> + </section> + +</section> + <section><title>Crypto 4.4.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index bc8b124b10..883e78f91e 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -24,6 +24,7 @@ -export([start/0, stop/0, info_lib/0, info_fips/0, supports/0, enable_fips_mode/1, version/0, bytes_to_integer/1]). +-export([equal_const_time/2]). -export([hash/2, hash_init/1, hash_update/2, hash_final/1]). -export([sign/4, sign/5, verify/5, verify/6]). -export([generate_key/2, generate_key/3, compute_key/4]). @@ -360,6 +361,35 @@ enable_fips_mode(_) -> ?nif_stub. %%%================================================================ %%% +%%% Compare in constant time +%%% +%%%================================================================ + +%%% Candidate for a NIF + +equal_const_time(X1, X2) -> + equal_const_time(X1, X2, true). + + +equal_const_time(<<B1,R1/binary>>, <<B2,R2/binary>>, Truth) -> + equal_const_time(R1, R2, Truth and (B1 == B2)); +equal_const_time(<<_,R1/binary>>, <<>>, Truth) -> + equal_const_time(R1, <<>>, Truth and false); +equal_const_time(<<>>, <<>>, Truth) -> + Truth; + +equal_const_time([H1|T1], [H2|T2], Truth) -> + equal_const_time(T1, T2, Truth and (H1 == H2)); +equal_const_time([_|T1], [], Truth) -> + equal_const_time(T1, [], Truth and false); +equal_const_time([], [], Truth) -> + Truth; + +equal_const_time(_, _, _) -> + false. + +%%%================================================================ +%%% %%% Hashing %%% %%%================================================================ diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index cbfa96cc16..e6e3ca7ff3 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -115,8 +115,8 @@ groups() -> {group, no_blowfish_cfb64}, {group, no_blowfish_ofb64}, {group, aes_cbc128}, - {group, no_aes_cfb8}, - {group, no_aes_cfb128}, + {group, aes_cfb8}, + {group, aes_cfb128}, {group, aes_cbc256}, {group, no_aes_ige256}, {group, no_rc2_cbc}, diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk index 0a3d9f45e4..c4c9208e29 100644 --- a/lib/crypto/vsn.mk +++ b/lib/crypto/vsn.mk @@ -1 +1 @@ -CRYPTO_VSN = 4.4.2 +CRYPTO_VSN = 4.4.2.3 diff --git a/lib/erl_interface/doc/src/ei_connect.xml b/lib/erl_interface/doc/src/ei_connect.xml index 2dd0a285fe..8402787c67 100644 --- a/lib/erl_interface/doc/src/ei_connect.xml +++ b/lib/erl_interface/doc/src/ei_connect.xml @@ -1073,7 +1073,7 @@ self->num = fd; </func> <func> - <name since=""><ret>int</ret><nametext>ei_send_reg_encoded_tmo(int fd, const erlang_pid *from, const char *to, const char *buf, int len)</nametext></name> + <name since=""><ret>int</ret><nametext>ei_send_reg_encoded_tmo(int fd, const erlang_pid *from, const char *to, const char *buf, int len, unsigned timeout_ms)</nametext></name> <fsummary>Obsolete function to send a message to a registered name with time-out.</fsummary> <desc> diff --git a/lib/erl_interface/doc/src/notes.xml b/lib/erl_interface/doc/src/notes.xml index 1f95382704..cf5958c971 100644 --- a/lib/erl_interface/doc/src/notes.xml +++ b/lib/erl_interface/doc/src/notes.xml @@ -31,6 +31,73 @@ </header> <p>This document describes the changes made to the Erl_interface application.</p> +<section><title>Erl_Interface 3.11.3.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix bug where sending of large data with ei_send_*/ei_rpc + with infinite timeout could fail when the tcp buffer + becomes full.</p> + <p> + Fault has existed since OTP-21.</p> + <p> + Own Id: OTP-17358 Aux Id: ERLERL-610 </p> + </item> + </list> + </section> + + + <section><title>Known Bugs and Problems</title> + <list> + <item> + <p> + The <c>ei</c> API for decoding/encoding terms is not + fully 64-bit compatible since terms that have a + representation on the external term format larger than 2 + GB cannot be handled.</p> + <p> + Own Id: OTP-16607 Aux Id: OTP-16608 </p> + </item> + </list> + </section> + +</section> + +<section><title>Erl_Interface 3.11.3.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix link error "multiple definition of + `ei_default_socket_callbacks'" for gcc version 10 or when + built with gcc option -fno-common. Error exists since + OTP-21.3.</p> + <p> + Own Id: OTP-16412 Aux Id: PR-2503 </p> + </item> + </list> + </section> + + + <section><title>Known Bugs and Problems</title> + <list> + <item> + <p> + The <c>ei</c> API for decoding/encoding terms is not + fully 64-bit compatible since terms that have a + representation on the external term format larger than 2 + GB cannot be handled.</p> + <p> + Own Id: OTP-16607 Aux Id: OTP-16608 </p> + </item> + </list> + </section> + +</section> + <section><title>Erl_Interface 3.11.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/erl_interface/src/misc/ei_portio.c b/lib/erl_interface/src/misc/ei_portio.c index bccc86c1b1..a076e1ef7d 100644 --- a/lib/erl_interface/src/misc/ei_portio.c +++ b/lib/erl_interface/src/misc/ei_portio.c @@ -404,6 +404,12 @@ static int writev_ctx_t__(ei_socket_callbacks *cbs, void *ctx, do { error = cbs->writev(ctx, (const void *) iov, iovcnt, len, ms); } while (error == EINTR); + + /* It should not be possible for writev_ctx_t__ to return EAGAIN, + because when the fd is set in non-blocking we always do a select on + the fd before trying to write. And if we do not do the select the fd + is always in blocking mode. */ + return error; } @@ -417,7 +423,8 @@ int ei_writev_fill_ctx_t__(ei_socket_callbacks *cbs, void *ctx, struct iovec *current_iov; int current_iovcnt; int fd, error; - int basic; + int non_blocking = !(cbs->flags & EI_SCLBK_FLG_FULL_IMPL) && + ms != EI_SCLBK_INF_TMO; if (!cbs->writev) return ENOTSUP; @@ -426,12 +433,10 @@ int ei_writev_fill_ctx_t__(ei_socket_callbacks *cbs, void *ctx, if (error) return error; - basic = !(cbs->flags & EI_SCLBK_FLG_FULL_IMPL); - for (sum = 0, i = 0; i < iovcnt; ++i) { sum += iov[i].iov_len; } - if (basic && ms != 0U) { + if (non_blocking) { SET_NONBLOCKING(fd); } current_iovcnt = iovcnt; @@ -442,7 +447,7 @@ int ei_writev_fill_ctx_t__(ei_socket_callbacks *cbs, void *ctx, error = writev_ctx_t__(cbs, ctx, current_iov, current_iovcnt, &i, ms); if (error) { *len = done; - if (ms != 0U) { + if (non_blocking) { SET_BLOCKING(fd); } if (iov_base != NULL) { @@ -478,7 +483,7 @@ int ei_writev_fill_ctx_t__(ei_socket_callbacks *cbs, void *ctx, break; } } - if (basic && ms != 0U) { + if (non_blocking) { SET_BLOCKING(fd); } if (iov_base != NULL) { @@ -752,9 +757,10 @@ int ei_read_fill_ctx__(ei_socket_callbacks *cbs, void *ctx, char* buf, ssize_t * int ei_write_fill_ctx_t__(ei_socket_callbacks *cbs, void *ctx, const char *buf, ssize_t *len, unsigned ms) { ssize_t tot = *len, done = 0; - int error, fd = -1, basic = !(cbs->flags & EI_SCLBK_FLG_FULL_IMPL); + int error, fd = -1, non_blocking = !(cbs->flags & EI_SCLBK_FLG_FULL_IMPL) && + ms != EI_SCLBK_INF_TMO; - if (basic && ms != 0U) { + if (non_blocking) { error = EI_GET_FD__(cbs, ctx, &fd); if (error) return error; @@ -765,14 +771,14 @@ int ei_write_fill_ctx_t__(ei_socket_callbacks *cbs, void *ctx, const char *buf, error = write_ctx_t__(cbs, ctx, buf+done, &write_len, ms); if (error) { *len = done; - if (basic && ms != 0U) { + if (non_blocking) { SET_BLOCKING(fd); } return error; } done += write_len; } while (done < tot); - if (basic && ms != 0U) { + if (non_blocking) { SET_BLOCKING(fd); } *len = done; diff --git a/lib/erl_interface/src/misc/ei_portio.h b/lib/erl_interface/src/misc/ei_portio.h index a84b5ca09c..25372d5ff0 100644 --- a/lib/erl_interface/src/misc/ei_portio.h +++ b/lib/erl_interface/src/misc/ei_portio.h @@ -47,7 +47,7 @@ int ei_writev_fill_ctx_t__(ei_socket_callbacks *cbs, void *ctx, const struct iov int ei_socket_callbacks_have_writev__(ei_socket_callbacks *cbs); #endif -ei_socket_callbacks ei_default_socket_callbacks; +extern ei_socket_callbacks ei_default_socket_callbacks; #define EI_FD_AS_CTX__(FD) \ ((void *) (long) (FD)) diff --git a/lib/erl_interface/test/ei_connect_SUITE.erl b/lib/erl_interface/test/ei_connect_SUITE.erl index 75b6bf18da..a219d35ed6 100644 --- a/lib/erl_interface/test/ei_connect_SUITE.erl +++ b/lib/erl_interface/test/ei_connect_SUITE.erl @@ -28,6 +28,7 @@ init_per_testcase/2, ei_send/1, ei_reg_send/1, + ei_reg_send_large/1, ei_format_pid/1, ei_rpc/1, rpc_test/1, @@ -42,7 +43,7 @@ suite() -> {timetrap, {seconds, 30}}]. all() -> - [ei_send, ei_reg_send, ei_rpc, ei_format_pid, ei_send_funs, + [ei_send, ei_reg_send, ei_reg_send_large, ei_rpc, ei_format_pid, ei_send_funs, ei_threaded_send, ei_set_get_tracelevel]. init_per_testcase(Case, Config) -> @@ -105,6 +106,21 @@ ei_reg_send(Config) when is_list(Config) -> runner:recv_eot(P), ok. +ei_reg_send_large(Config) when is_list(Config) -> + P = runner:start(Config, ?interpret), + 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0), + {ok,Fd} = ei_connect(P, node()), + + ARegName = a_strange_registred_name, + register(ARegName, self()), + ok = ei_reg_send(P, Fd, ARegName, AMsg={another,[strange],message, + <<0:(32*1024*1024*8)>>}), + receive AMsg -> ok end, + + runner:send_eot(P), + runner:recv_eot(P), + ok. + ei_threaded_send(Config) when is_list(Config) -> Einode = filename:join(proplists:get_value(data_dir, Config), "einode"), N = 15, diff --git a/lib/erl_interface/vsn.mk b/lib/erl_interface/vsn.mk index 4e31b3835d..608f05c41e 100644 --- a/lib/erl_interface/vsn.mk +++ b/lib/erl_interface/vsn.mk @@ -1,2 +1,2 @@ -EI_VSN = 3.11.3 +EI_VSN = 3.11.3.2 ERL_INTERFACE_VSN = $(EI_VSN) diff --git a/lib/ftp/doc/src/notes.xml b/lib/ftp/doc/src/notes.xml index 61da079900..5359db1b90 100644 --- a/lib/ftp/doc/src/notes.xml +++ b/lib/ftp/doc/src/notes.xml @@ -33,7 +33,38 @@ <file>notes.xml</file> </header> - <section><title>Ftp 1.0.2</title> + <section><title>Ftp 1.0.2.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A possibly infinite loop is removed.</p> + <p> + Own Id: OTP-16243 Aux Id: PR-2436, OTP-16056 </p> + </item> + </list> + </section> + +</section> + +<section><title>Ftp 1.0.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A possibly infinite loop when receiving messages divided + in parts is removed.</p> + <p> + Own Id: OTP-16056</p> + </item> + </list> + </section> + +</section> + +<section><title>Ftp 1.0.2</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/ftp/src/ftp.erl b/lib/ftp/src/ftp.erl index 18cd8c7524..2f7a67df67 100644 --- a/lib/ftp/src/ftp.erl +++ b/lib/ftp/src/ftp.erl @@ -1375,11 +1375,11 @@ handle_info({Transport, Socket, Data}, #state{csock = {Transport, Socket}, verbose = Verbose, caller = Caller, client = From, - ctrl_data = {CtrlData, AccLines, + ctrl_data = {BinCtrlData, AccLines, LineStatus}} = State0) -> - ?DBG('--ctrl ~p ----> ~s~p~n',[Socket,<<CtrlData/binary, Data/binary>>,State]), - case ftp_response:parse_lines(<<CtrlData/binary, Data/binary>>, + ?DBG('--ctrl ~p ----> ~s~p~n',[Socket,<<BinCtrlData/binary, Data/binary>>,State]), + case ftp_response:parse_lines(<<BinCtrlData/binary, Data/binary>>, AccLines, LineStatus) of {ok, Lines, NextMsgData} -> verbose(Lines, Verbose, 'receive'), @@ -1399,10 +1399,14 @@ handle_info({Transport, Socket, Data}, #state{csock = {Transport, Socket}, ctrl_data = {NextMsgData, [], start}}) end; - {continue, NewCtrlData} -> - ?DBG(' ...Continue... ctrl_data=~p~n',[NewCtrlData]), - State = activate_ctrl_connection(State0), - {noreply, State#state{ctrl_data = NewCtrlData}} + {continue, CtrlData} when CtrlData =/= State0#state.ctrl_data -> + ?DBG(' ...Continue... ctrl_data=~p~n',[CtrlData]), + State1 = State0#state{ctrl_data = CtrlData}, + State = activate_ctrl_connection(State1), + {noreply, State}; + {continue, CtrlData} -> + ?DBG(' ...Continue... ctrl_data=~p~n',[CtrlData]), + {noreply, State0} end; %% If the server closes the control channel it is diff --git a/lib/ftp/vsn.mk b/lib/ftp/vsn.mk index 9f14658099..4ef5ebb509 100644 --- a/lib/ftp/vsn.mk +++ b/lib/ftp/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = ftp -FTP_VSN = 1.0.2 +FTP_VSN = 1.0.2.2 PRE_VSN = APP_VSN = "$(APPLICATION)-$(FTP_VSN)$(PRE_VSN)" diff --git a/lib/inets/doc/src/httpd.xml b/lib/inets/doc/src/httpd.xml index 66369e8df9..ff01a4c10c 100644 --- a/lib/inets/doc/src/httpd.xml +++ b/lib/inets/doc/src/httpd.xml @@ -353,6 +353,82 @@ text/plain asc txt</pre> <p>By default, the value is as before, that is, <c>minimal</c>.</p> </item> + + <tag><marker id="prop_logger"></marker>{logger, Options::list()}</tag> + <item> + + <p>Currently only one option is supported: </p> + + <taglist> + <tag><c>{error, ServerID::atom()}</c></tag> + <item> <p>Produces + <seealso marker="kernel:logger#type-log_event">logger events</seealso> + on logger <seealso marker="kernel:logger#type-level">level error</seealso> + under the hierarchical logger <seealso marker="kernel:logger#type-log_event">domain:</seealso> <c>[otp, inets, httpd, ServerID, error]</c> + The built in logger formatting + function produces log entries from the + error reports:</p> + + <code> +#{server_name => string() + protocol => internal | 'TCP' | 'TLS' | 'HTTP', + transport => "TCP "| "TLS", %% Present when protocol = 'HTTP' + uri => string(), %% Present when protocol = 'HTTP' and URI is valid + peer => inet:peername(), + host => inet:hostname(), + reason => term() +} +</code> + +<p>An example of a log entry with only default settings of logger</p> + +<code> +=ERROR REPORT==== 9-Oct-2019::09:33:27.350235 === + Server: My Server + Protocol: HTTP +Transport: TLS + URI: /not_there + Host: 127.0.1.1:80 + Peer: 127.0.0.1:45253 + Reason: [{statuscode,404},{description,"Object Not Found"}] +</code> + +<p>Using this option makes mod_log and mod_disk_log error logs redundant.</p> + + <p>Add the filter</p> + <code> +{fun logger_filters:domain/2, + {log,equal,[otp,inets, httpd, ServerID, error]}</code> + + to appropriate logger handler to handle the events. For + example to write the error log from an httpd server with a + <c>ServerID</c> of <c>my_server</c> to a file you can use the following + sys.config: + + <code>[{kernel, + [{logger, + [{handler, http_error_test, logger_std_h, + #{config => #{ file => "log/http_error.log" }, + filters => [{inets_httpd, {fun logger_filters:domain/2, + {log, equal, + [otp, inets, httpd, my_server, error] + }}}], + filter_default => stop }}]}]}]. + </code> + + <p>or if you want to add it to the default logger via an API:</p> + + <code>logger:add_handler_filter(default, + inets_httpd, + {fun logger_filters:domain/2, + {log, equal, + [otp, inets, httpd, my_server, error]}}).</code> + + </item> + </taglist> + + </item> + <tag><marker id="prop_log_format"></marker>{log_format, common | combined}</tag> <item> <p>Defines if access logs are to be written according to the <c>common</c> diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index a1b5dfc309..a05ce5050c 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,7 +33,39 @@ <file>notes.xml</file> </header> - <section><title>Inets 7.0.7</title> + <section><title>Inets 7.0.7.2</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Add HTTP server error logging vi logger</p> + <p> + Own Id: OTP-16019</p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 7.0.7.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + mod_esi will now always propagate the actual HTTP status + code that it anwsered with, to later mod-modules, and not + in some cases hardcode 200.</p> + <p> + Own Id: OTP-16049 Aux Id: ERIERL-395 </p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 7.0.7</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/include/httpd.hrl b/lib/inets/include/httpd.hrl index fb338d5c68..a4b6b40b90 100644 --- a/lib/inets/include/httpd.hrl +++ b/lib/inets/include/httpd.hrl @@ -24,7 +24,9 @@ -include_lib("kernel/include/file.hrl"). --record(init_data,{peername,resolve}). +-record(init_data,{peername, + sockname, + resolve}). -record(mod,{init_data, data=[], diff --git a/lib/inets/src/http_lib/http_transport.erl b/lib/inets/src/http_lib/http_transport.erl index 2e3e099e5b..d5e1d71336 100644 --- a/lib/inets/src/http_lib/http_transport.erl +++ b/lib/inets/src/http_lib/http_transport.erl @@ -487,4 +487,4 @@ negotiate({essl, _}, Socket, Timeout) -> negotiate_ssl(Socket, Timeout). negotiate_ssl(Socket, Timeout) -> - ssl:ssl_accept(Socket, Timeout). + ssl:handshake(Socket, Timeout). diff --git a/lib/inets/src/http_server/Makefile b/lib/inets/src/http_server/Makefile index 1c05d454a5..9848fd4b35 100644 --- a/lib/inets/src/http_server/Makefile +++ b/lib/inets/src/http_server/Makefile @@ -57,6 +57,7 @@ MODULES = \ httpd_file\ httpd_instance_sup \ httpd_log \ + httpd_logger \ httpd_manager \ httpd_misc_sup \ httpd_request \ diff --git a/lib/inets/src/http_server/httpd_acceptor.erl b/lib/inets/src/http_server/httpd_acceptor.erl index 447faec12f..d08c578acb 100644 --- a/lib/inets/src/http_server/httpd_acceptor.erl +++ b/lib/inets/src/http_server/httpd_acceptor.erl @@ -21,8 +21,7 @@ -module(httpd_acceptor). -include("httpd.hrl"). --include("httpd_internal.hrl"). -%%-include("inets_internal.hrl"). +-include_lib("kernel/include/logger.hrl"). %% Internal application API -export([start_link/7, start_link/8]). @@ -37,34 +36,16 @@ %% start_link start_link(Manager, SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout) -> - %% ?hdrd("start link", - %% [{manager, Manager}, - %% {socket_type, SocketType}, - %% {address, Addr}, - %% {port, Port}, - %% {timeout, AcceptTimeout}]), Args = [self(), Manager, SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout], proc_lib:start_link(?MODULE, acceptor_init, Args). start_link(Manager, SocketType, Addr, Port, ListenSocket, IpFamily, ConfigDb, AcceptTimeout) -> - %% ?hdrd("start link", - %% [{manager, Manager}, - %% {socket_type, SocketType}, - %% {listen_socket, ListenSocket}, - %% {timeout, AcceptTimeout}]), Args = [self(), Manager, SocketType, Addr, Port, ListenSocket, IpFamily, ConfigDb, AcceptTimeout], proc_lib:start_link(?MODULE, acceptor_init, Args). acceptor_init(Parent, Manager, SocketType, Addr, Port, {ListenOwner, ListenSocket}, IpFamily, ConfigDb, AcceptTimeout) -> - %% ?hdrd("acceptor init", - %% [{parent, Parent}, - %% {manager, Manager}, - %% {socket_type, SocketType}, - %% {listen_owner, ListenOwner}, - %% {listen_socket, ListenSocket}, - %% {timeout, AcceptTimeout}]), link(ListenOwner), proc_lib:init_ack(Parent, {ok, self()}), acceptor_loop(Manager, SocketType, Addr, Port, @@ -131,21 +112,16 @@ acceptor_loop(Manager, SocketType, Addr, Port, ListenSocket, IpFamily, ConfigDb, %% {timeout, AcceptTimeout}]), case (catch http_transport:accept(SocketType, ListenSocket, 50000)) of {ok, Socket} -> - %% ?hdrv("accepted", [{socket, Socket}]), handle_connection(Addr, Port, Manager, ConfigDb, AcceptTimeout, SocketType, Socket), ?MODULE:acceptor_loop(Manager, SocketType, Addr, Port, ListenSocket, IpFamily, ConfigDb,AcceptTimeout); {error, Reason} -> - %% ?hdri("accept failed", [{reason, Reason}]), - handle_error(Reason, ConfigDb), + handle_error(Reason, ConfigDb, ?LOCATION), ?MODULE:acceptor_loop(Manager, SocketType, Addr, Port, ListenSocket, IpFamily, ConfigDb, AcceptTimeout); {'EXIT', Reason} -> - %% ?hdri("accept exited", [{reason, Reason}]), - ReasonString = - lists:flatten(io_lib:format("Accept exit: ~p", [Reason])), - accept_failed(ConfigDb, ReasonString) + accept_failed(ConfigDb, [{accept_failed, Reason}], ?LOCATION) end. @@ -155,18 +131,18 @@ handle_connection(Address, Port, Manager, ConfigDb, AcceptTimeout, SocketType, http_transport:controlling_process(SocketType, Socket, Pid), httpd_request_handler:socket_ownership_transfered(Pid, SocketType, Socket). -handle_error(timeout, _) -> +handle_error(timeout, _,_) -> ok; -handle_error({enfile, _}, _) -> +handle_error({enfile, _}, _, _) -> %% Out of sockets... sleep(200); -handle_error(emfile, _) -> +handle_error(emfile, _, _) -> %% Too many open files -> Out of sockets... sleep(200); -handle_error(closed, _) -> +handle_error(closed, _, _) -> error_logger:info_report("The httpd accept socket was closed by " "a third party. " "This will not have an impact on inets " @@ -180,33 +156,30 @@ handle_error(closed, _) -> %% and is not a problem for the server, so we want %% to terminate normal so that we can restart without any %% error messages. -handle_error(econnreset,_) -> +handle_error(econnreset,_,_) -> exit(normal); -handle_error(econnaborted, _) -> +handle_error(econnaborted, _,_) -> ok; -handle_error(esslaccept, _) -> +handle_error(esslaccept, _, _) -> %% The user has selected to cancel the installation of %% the certifikate, This is not a real error, so we do %% not write an error message. ok; -handle_error(Reason, ConfigDb) -> - String = lists:flatten(io_lib:format("Accept error: ~p", [Reason])), - accept_failed(ConfigDb, String). +handle_error(Reason, ConfigDb, Location) -> + accept_failed(ConfigDb, {accept_failed, Reason}, Location). -spec accept_failed(ConfigDB :: term(), - ReasonString :: string()) -> no_return(). - -accept_failed(ConfigDb, String) -> - error_logger:error_report(String), - InitData = #init_data{peername = {0, "unknown"}}, - Info = #mod{config_db = ConfigDb, init_data = InitData}, - mod_log:error_log(Info, String), - mod_disk_log:error_log(Info, String), - exit({accept_failed, String}). + ReasonString :: string(), map()) -> no_return(). + +accept_failed(ConfigDb, Reason, Location) -> + InitData = #init_data{peername = {0, "unknown"}, sockname = {0, "unknown"}}, + ModData = #mod{config_db = ConfigDb, init_data = InitData}, + httpd_util:error_log(ConfigDb, httpd_logger:error_report('TCP', Reason, ModData, Location)), + exit({accept_failed, Reason}). sleep(T) -> receive after T -> ok end. diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index 9e54f2b2c5..d42fc7c607 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -56,21 +56,16 @@ %% Phase 1: Load load(ConfigFile) -> - ?hdrv("load config", [{config_file, ConfigFile}]), case read_config_file(ConfigFile) of {ok, Config} -> - ?hdrt("config read", []), case bootstrap(Config) of {error, Reason} -> - ?hdri("bootstrap failed", [{reason, Reason}]), {error, Reason}; {ok, Modules} -> - ?hdrd("config bootstrapped", [{modules, Modules}]), load_config(Config, lists:append(Modules, [?MODULE])) end; {error, Reason} -> - ?hdri("failed reading config file", [{reason, Reason}]), - {error, ?NICE("Error while reading config file: "++Reason)} + {error, ?NICE("Error while reading config file: "++Reason)} end. load(eof, []) -> @@ -151,37 +146,25 @@ load("BindAddress " ++ Address0, []) -> try begin - ?hdrv("load BindAddress", [{address0, Address0}]), {Address, IpFamily} = case string:tokens(Address0, [$|]) of [Address1] -> - ?hdrv("load BindAddress", [{address1, Address1}]), {clean_address(Address1), inet}; [Address1, IpFamilyStr] -> - ?hdrv("load BindAddress", - [{address1, Address1}, - {ipfamily_str, IpFamilyStr}]), - {clean_address(Address1), make_ipfamily(IpFamilyStr)}; + {clean_address(Address1), make_ipfamily(IpFamilyStr)}; _Bad -> - ?hdrv("load BindAddress - bad address", - [{bad_address, _Bad}]), - throw({error, {bad_bind_address, Address0}}) + throw({error, {bad_bind_address, Address0}}) end, - ?hdrv("load BindAddress - address and ipfamily separated", - [{address, Address}, {ipfamily, IpFamily}]), - case Address of "*" -> {ok, [], [{bind_address, any}, {ipfamily, IpFamily}]}; _ -> case httpd_util:ip_address(Address, IpFamily) of {ok, IPAddr} -> - ?hdrv("load BindAddress - checked", - [{ip_address, IPAddr}]), - Entries = [{bind_address, IPAddr}, - {ipfamily, IpFamily}], - {ok, [], Entries}; + Entries = [{bind_address, IPAddr}, + {ipfamily, IpFamily}], + {ok, [], Entries}; {error, _} -> {error, ?NICE(Address ++ " is an invalid address")} end @@ -189,11 +172,9 @@ load("BindAddress " ++ Address0, []) -> end catch throw:{error, {bad_bind_address, _}} -> - ?hdrv("load BindAddress - bad bind address", []), {error, ?NICE(Address0 ++ " is an invalid address")}; throw:{error, {bad_ipfamily, _}} -> - ?hdrv("load BindAddress - bad ipfamily", []), - {error, ?NICE(Address0 ++ " has an invalid ipfamily")} + {error, ?NICE(Address0 ++ " has an invalid ipfamily")} end; load("KeepAlive " ++ OnorOff, []) -> @@ -592,6 +573,12 @@ validate_config_params([{default_type, Value} | Rest]) when is_list(Value) -> validate_config_params([{default_type, Value} | _]) -> throw({default_type, Value}); +validate_config_params([{logger, Value} | Rest]) when is_list(Value) -> + true = validate_logger(Value), + validate_config_params(Rest); +validate_config_params([{logger, Value} | _]) -> + throw({logger, Value}); + validate_config_params([{ssl_certificate_file = Key, Value} | Rest]) -> ok = httpd_util:file_validate(Key, Value), validate_config_params(Rest); @@ -671,12 +658,10 @@ is_bind_address(Value, IpFamily) -> end. store(ConfigList0) -> - ?hdrd("store", []), try validate_config_params(ConfigList0) of ok -> Modules = proplists:get_value(modules, ConfigList0, ?DEFAULT_MODS), - ?hdrt("store", [{modules, Modules}]), Port = proplists:get_value(port, ConfigList0), Addr = proplists:get_value(bind_address, ConfigList0, any), Profile = proplists:get_value(profile, ConfigList0, default), @@ -688,8 +673,6 @@ store(ConfigList0) -> ConfigList) catch throw:Error -> - ?hdri("store - config parameter validation failed", - [{error, Error}]), {error, {invalid_option, Error}} end. @@ -907,11 +890,9 @@ load_config(Config, Modules) -> load_config(Config, Modules, Contexts, []). load_config([], _Modules, _Contexts, ConfigList) -> - ?hdrv("config loaded", []), {ok, ConfigList}; load_config([Line|Config], Modules, Contexts, ConfigList) -> - ?hdrt("load config", [{config_line, Line}]), case load_traverse(Line, Contexts, Modules, [], ConfigList, no) of {ok, NewContexts, NewConfigList} -> load_config(Config, Modules, NewContexts, NewConfigList); @@ -935,17 +916,12 @@ load_traverse(_Line, [], [], NewContexts, ConfigList, yes) -> {ok, lists:reverse(NewContexts), ConfigList}; load_traverse(Line, [Context|Contexts], [Module|Modules], NewContexts, ConfigList, State) -> - ?hdrt("load config traverse", - [{context, Context}, {httpd_module, Module}, {state, State}]), case catch apply(Module, load, [Line, Context]) of {'EXIT', {function_clause, _FC}} -> - ?hdrt("does not handle load config", - [{config_line, Line}, {fc, _FC}]), load_traverse(Line, Contexts, Modules, [Context|NewContexts], ConfigList, State); {'EXIT', {undef, _}} -> - ?hdrt("does not implement load", []), load_traverse(Line, Contexts, Modules, [Context|NewContexts], ConfigList, yes); @@ -955,30 +931,23 @@ load_traverse(Line, [Context|Contexts], [Module|Modules], NewContexts, [Context|NewContexts], ConfigList, State); ok -> - ?hdrt("line processed", []), load_traverse(Line, Contexts, Modules, [Context|NewContexts], ConfigList, yes); {ok, NewContext} -> - ?hdrt("line processed", [{new_context, NewContext}]), load_traverse(Line, Contexts, Modules, [NewContext|NewContexts], ConfigList, yes); {ok, NewContext, ConfigEntry} when is_tuple(ConfigEntry) -> - ?hdrt("line processed", - [{new_context, NewContext}, {config_entry, ConfigEntry}]), load_traverse(Line, Contexts, Modules, [NewContext|NewContexts], [ConfigEntry|ConfigList], yes); {ok, NewContext, ConfigEntry} when is_list(ConfigEntry) -> - ?hdrt("line processed", - [{new_context, NewContext}, {config_entry, ConfigEntry}]), load_traverse(Line, Contexts, Modules, [NewContext|NewContexts], lists:append(ConfigEntry, ConfigList), yes); {error, Reason} -> - ?hdrv("line processing failed", [{reason, Reason}]), {error, Reason} end. @@ -1063,7 +1032,6 @@ suffixes(MimeType,[Suffix|Rest]) -> store(ConfigDB, _ConfigList, _Modules, []) -> {ok, ConfigDB}; store(ConfigDB, ConfigList, Modules, [ConfigListEntry|Rest]) -> - ?hdrt("store", [{entry, ConfigListEntry}]), case store_traverse(ConfigListEntry, ConfigList, Modules) of {ok, ConfigDBEntry} when is_tuple(ConfigDBEntry) -> ets:insert(ConfigDB, ConfigDBEntry), @@ -1080,20 +1048,15 @@ store(ConfigDB, ConfigList, Modules, [ConfigListEntry|Rest]) -> store_traverse(_ConfigListEntry, _ConfigList,[]) -> {error, ?NICE("Unable to store configuration...")}; store_traverse(ConfigListEntry, ConfigList, [Module|Rest]) -> - ?hdrt("store traverse", - [{httpd_module, Module}, {entry, ConfigListEntry}]), case catch apply(Module, store, [ConfigListEntry, ConfigList]) of {'EXIT',{function_clause,_}} -> - ?hdrt("does not handle store config", []), store_traverse(ConfigListEntry,ConfigList,Rest); {'EXIT',{undef, _}} -> - ?hdrt("does not implement store", []), store_traverse(ConfigListEntry,ConfigList,Rest); {'EXIT', Reason} -> error_logger:error_report({'EXIT',Reason}), store_traverse(ConfigListEntry,ConfigList,Rest); Result -> - ?hdrt("config entry processed", [{result, Result}]), Result end. @@ -1223,6 +1186,10 @@ white_space_clean(String) -> re:replace(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$","", [{return,list}, global]). +validate_logger([{error, Domain}]) when is_atom(Domain) -> + true; +validate_logger(List) -> + throw({logger, List}). %%%========================================================================= %%% Deprecated remove in 19 diff --git a/lib/inets/src/http_server/httpd_internal.hrl b/lib/inets/src/http_server/httpd_internal.hrl index 09d720ee85..dfe9f1fa9f 100644 --- a/lib/inets/src/http_server/httpd_internal.hrl +++ b/lib/inets/src/http_server/httpd_internal.hrl @@ -41,38 +41,4 @@ {sizefmt,"abbrev"}]). --ifdef(inets_error). --define(ERROR(Format, Args), io:format("E(~p:~p:~p) : "++Format++"~n", - [self(),?MODULE,?LINE]++Args)). --else. --define(ERROR(F,A),[]). --endif. - --ifdef(inets_log). --define(LOG(Format, Args), io:format("L(~p:~p:~p) : "++Format++"~n", - [self(),?MODULE,?LINE]++Args)). --else. --define(LOG(F,A),[]). --endif. - --ifdef(inets_debug). --define(DEBUG(Format, Args), io:format("D(~p:~p:~p) : "++Format++"~n", - [self(),?MODULE,?LINE]++Args)). --else. --define(DEBUG(F,A),[]). --endif. - --ifdef(inets_cdebug). --define(CDEBUG(Format, Args), io:format("C(~p:~p:~p) : "++Format++"~n", - [self(),?MODULE,?LINE]++Args)). --else. --define(CDEBUG(F,A),[]). --endif. - --define(SERVICE, httpd). --define(hdri(Label, Content), ?report_important(Label, ?SERVICE, Content)). --define(hdrv(Label, Content), ?report_verbose(Label, ?SERVICE, Content)). --define(hdrd(Label, Content), ?report_debug(Label, ?SERVICE, Content)). --define(hdrt(Label, Content), ?report_trace(Label, ?SERVICE, Content)). - -endif. % -ifdef(httpd_internal_hrl). diff --git a/lib/inets/src/http_server/httpd_logger.erl b/lib/inets/src/http_server/httpd_logger.erl new file mode 100644 index 0000000000..a9297dc26a --- /dev/null +++ b/lib/inets/src/http_server/httpd_logger.erl @@ -0,0 +1,143 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(httpd_logger). + +-include_lib("kernel/include/logger.hrl"). +-include_lib("inets/include/httpd.hrl"). + +-export([error_report/4, log/3, format/1]). + +error_report(Protocol, Reason, #mod{init_data = #init_data{peername = PeerName, + sockname = SockName}, + socket_type = Type, + request_uri = URI, + config_db = Db}, + Location) -> + ServerName = httpd_util:lookup(Db, server_name), + Report0 = #{protocol => Protocol, + reason => Reason, + peer => PeerName, + host => SockName, + server_name => ServerName, + metadata => Location}, + Report1 = case URI of + undefined -> + Report0; + _ -> + Report0#{uri => URI} + end, + case Protocol of + 'HTTP' -> + Report1#{transport => transport_type(Type)}; + _ -> + Report1 + end. + +log(Level, #{metadata := MetaData} = Report, Domain) -> + logger:log(Level, maps:without([metadata], Report), + MetaData#{domain => [otp,inets, httpd, Domain, Level], + report_cb => fun ?MODULE:format/1}). + +format(#{protocol := Protocol} = Report) when Protocol == 'TLS'; + Protocol == 'TCP' -> + #{reason := Desc, + peer := {PeerPort, Peer}, + host := {HostPort, Host}, + server_name := ServerName + } = Report, + { + "~10s ~s~n" + "~10s ~s~n" + "~10s ~s:~p~n" + "~10s ~s:~p~n" + "~10s ~p~n" + "~n", + ["Server:", ServerName, + "Protocol:", atom_to_list(Protocol), + "Host:", Host, HostPort, + "Peer:", Peer, PeerPort, + "Reason:", Desc] + }; +format(#{protocol := 'HTTP' = Protocol, uri := URI} = Report) -> + #{reason := Desc, + transport := Transport, + peer := {PeerPort, Peer}, + host := {HostPort, Host}, + server_name := ServerName} = Report, + { + "~10s ~s~n" + "~10s ~s~n" + "~10s ~s~n" + "~10s ~s~n" + "~10s ~s:~p~n" + "~10s ~s:~p~n" + "~10s ~p~n" + "~n", + ["Server:", ServerName, + "Protocol:", atom_to_list(Protocol), + "Transport:", Transport, + "URI:", URI, + "Host:", Host, HostPort, + "Peer:", Peer, PeerPort, + "Reason:", Desc] + }; +format(#{protocol := 'HTTP' = Protocol} = Report) -> + #{reason := Desc, + transport := Transport, + peer := {PeerPort, Peer}, + host := {HostPort, Host}, + server_name := ServerName} = Report, + { + "~10s ~s~n" + "~10s ~s~n" + "~10s ~s~n" + "~10s ~s:~p~n" + "~10s ~s:~p~n" + "~10s ~p~n" + "~n", + ["Server:", ServerName, + "Protocol:", atom_to_list(Protocol), + "Transport:", Transport, + "Host:", Host, HostPort, + "Peer:", Peer, PeerPort, + "Reason:", Desc] + }; +format(#{protocol := internal = Protocol} = Report) -> + #{reason := Desc, + host := {HostPort, Host}, + server_name := ServerName + } = Report, + { + "~10s ~s~n" + "~10s ~s~n" + "~10s ~s:~p~n" + "~10s ~p~n" + "~n", + ["Server:", ServerName, + "Protocol:", atom_to_list(Protocol), + "Host:", Host, HostPort, + "Reason:", Desc] + }. + +transport_type(ip_comm) -> + "TCP"; +transport_type(_) -> + "TLS". diff --git a/lib/inets/src/http_server/httpd_request.erl b/lib/inets/src/http_server/httpd_request.erl index 9d7538a13d..0690102b58 100644 --- a/lib/inets/src/http_server/httpd_request.erl +++ b/lib/inets/src/http_server/httpd_request.erl @@ -44,10 +44,8 @@ %%% Internal application API %%%========================================================================= parse([Bin, Options]) -> - ?hdrt("parse", [{bin, Bin}, {max_sizes, Options}]), parse_method(Bin, [], 0, proplists:get_value(max_method, Options), Options, []); parse(Unknown) -> - ?hdrt("parse", [{unknown, Unknown}]), exit({bad_args, Unknown}). %% Functions that may be returned during the decoding process @@ -436,19 +434,13 @@ get_persistens(HTTPVersion,ParsedHeader,ConfigDB)-> %%older http/1.1 might be older Clients that %%use it. "keep-alive" when hd(NList) >= 49 -> - ?DEBUG("CONNECTION MODE: ~p",[true]), true; "close" -> - ?DEBUG("CONNECTION MODE: ~p",[false]), - false; + false; _Connect -> - ?DEBUG("CONNECTION MODE: ~p VALUE: ~p", - [false, _Connect]), - false + false end; _ -> - ?DEBUG("CONNECTION MODE: ~p VERSION: ~p", - [false, HTTPVersion]), false end; _ -> diff --git a/lib/inets/src/http_server/httpd_request_handler.erl b/lib/inets/src/http_server/httpd_request_handler.erl index d918f10424..e48555f4d7 100644 --- a/lib/inets/src/http_server/httpd_request_handler.erl +++ b/lib/inets/src/http_server/httpd_request_handler.erl @@ -34,7 +34,7 @@ -include("httpd.hrl"). -include("http_internal.hrl"). --include("httpd_internal.hrl"). +-include_lib("kernel/include/logger.hrl"). -define(HANDSHAKE_TIMEOUT, 5000). @@ -100,21 +100,39 @@ init([Manager, ConfigDB, AcceptTimeout]) -> {SocketType, Socket} = await_socket_ownership_transfer(AcceptTimeout), + Peername = http_transport:peername(SocketType, Socket), + Sockname = http_transport:sockname(SocketType, Socket), + %%Timeout value is in seconds we want it in milliseconds KeepAliveTimeOut = 1000 * httpd_util:lookup(ConfigDB, keep_alive_timeout, 150), case http_transport:negotiate(SocketType, Socket, ?HANDSHAKE_TIMEOUT) of - {error, Error} -> - exit({shutdown, Error}); %% Can be 'normal'. - ok -> - continue_init(Manager, ConfigDB, SocketType, Socket, KeepAliveTimeOut) + {error, {tls_alert, {_, AlertDesc}} = Error} -> + ModData = #mod{config_db = ConfigDB, init_data = #init_data{peername = Peername, + sockname = Sockname}}, + httpd_util:error_log(ConfigDB, httpd_logger:error_report('TLS', AlertDesc, + ModData, ?LOCATION)), + exit({shutdown, Error}); + {error, _Reason} = Error -> + %% This happens if the peer closes the connection + %% or the handshake is timed out. This is not + %% an error condition of the server and client will + %% retry in the timeout situation. + exit({shutdown, Error}); + {ok, TLSSocket} -> + continue_init(Manager, ConfigDB, SocketType, TLSSocket, + Peername, Sockname, KeepAliveTimeOut); + ok -> + continue_init(Manager, ConfigDB, SocketType, Socket, + Peername, Sockname, KeepAliveTimeOut) end. -continue_init(Manager, ConfigDB, SocketType, Socket, TimeOut) -> +continue_init(Manager, ConfigDB, SocketType, Socket, Peername, Sockname, + TimeOut) -> Resolve = http_transport:resolve(), - - Peername = httpd_socket:peername(SocketType, Socket), - InitData = #init_data{peername = Peername, resolve = Resolve}, + InitData = #init_data{peername = Peername, + sockname = Sockname, + resolve = Resolve}, Mod = #mod{config_db = ConfigDB, socket_type = SocketType, socket = Socket, @@ -163,14 +181,11 @@ continue_init(Manager, ConfigDB, SocketType, Socket, TimeOut) -> %% {stop, Reason, State} %% Description: Handling call messages %%-------------------------------------------------------------------- -handle_call(Request, From, #state{mod = ModData} = State) -> - Error = - lists:flatten( - io_lib:format("Unexpected request: " - "~n~p" - "~nto request handler (~p) from ~p" - "~n", [Request, self(), From])), - error_log(Error, ModData), +handle_call(Request, From, #state{mod = #mod{config_db = Db} = ModData} = State) -> + httpd_util:error_log(Db, + httpd_logger:error_report(internal, + [{unexpected_call, Request}, {to, self()}, {from, From}], ModData, + ?LOCATION)), {stop, {call_api_violation, Request, From}, State}. %%-------------------------------------------------------------------- @@ -179,14 +194,10 @@ handle_call(Request, From, #state{mod = ModData} = State) -> %% {stop, Reason, State} %% Description: Handling cast messages %%-------------------------------------------------------------------- -handle_cast(Msg, #state{mod = ModData} = State) -> - Error = - lists:flatten( - io_lib:format("Unexpected message: " - "~n~p" - "~nto request handler (~p)" - "~n", [Msg, self()])), - error_log(Error, ModData), +handle_cast(Msg, #state{mod = #mod{config_db = Db} = ModData} = State) -> + httpd_util:error_log(Db, + httpd_logger:error_report(internal, [{unexpected_cast, Msg}, {to, self()}], ModData, + ?LOCATION)), {noreply, State}. %%-------------------------------------------------------------------- @@ -223,10 +234,7 @@ handle_info({Proto, Socket, Data}, handle_msg(Result, NewState); {error, {size_error, MaxSize, ErrCode, ErrStr}, Version} -> NewModData = ModData#mod{http_version = Version}, - httpd_response:send_status(NewModData, ErrCode, ErrStr), - Reason = io_lib:format("~p: ~p max size is ~p~n", - [ErrCode, ErrStr, MaxSize]), - error_log(Reason, NewModData), + httpd_response:send_status(NewModData, ErrCode, ErrStr, {max_size, MaxSize}), {stop, normal, State#state{response_sent = true, mod = NewModData}}; @@ -255,14 +263,12 @@ handle_info({ssl_error, _, _} = Reason, State) -> %% Timeouts handle_info(timeout, #state{mfa = {_, parse, _}} = State) -> - %% error_log("No request received on keep-alive connection " - %% "before server side timeout", ModData), - %% No response should be sent! + %% No request received on keep-alive connection + %% before server side timeout. No response should be sent! {stop, normal, State#state{response_sent = true}}; handle_info(timeout, #state{mod = ModData} = State) -> - httpd_response:send_status(ModData, 408, "Request timeout"), - error_log("The client did not send the whole request before the " - "server side timeout", ModData), + httpd_response:send_status(ModData, 408, "Request timeout", "The client did not send the whole request before the " + "server side timeout"), {stop, normal, State#state{response_sent = true}}; handle_info(check_data_first, #state{data = Data, byte_limit = Byte_Limit} = State) -> case Data >= (Byte_Limit*3) of @@ -285,13 +291,11 @@ handle_info({'EXIT', _, Reason}, State) -> {stop, Reason, State}; %% Default case -handle_info(Info, #state{mod = ModData} = State) -> - Error = lists:flatten( - io_lib:format("Unexpected info: " - "~n~p" - "~nto request handler (~p)" - "~n", [Info, self()])), - error_log(Error, ModData), +handle_info(Info, #state{mod = #mod{config_db = Db} =ModData} = State) -> + httpd_util:error_log(Db, + httpd_logger:error_report(internal, + [{unexpected_info, Info}, {to, self()}], ModData, + ?LOCATION)), {noreply, State}. @@ -310,10 +314,6 @@ terminate({shutdown,_}, State) -> do_terminate(State); terminate(Reason, #state{response_sent = false, mod = ModData} = State) -> httpd_response:send_status(ModData, 500, none), - ReasonStr = - lists:flatten(io_lib:format("~s - ~p", - [httpd_util:reason_phrase(500), Reason])), - error_log(ReasonStr, ModData), terminate(Reason, State#state{response_sent = true, mod = ModData}); terminate(_Reason, State) -> do_terminate(State). @@ -419,26 +419,18 @@ handle_http_msg({Method, Uri, Version, {RecordHeaders, Headers}, Body}, end; {error, {not_supported, What}} -> httpd_response:send_status(ModData#mod{http_version = Version}, - 501, {Method, Uri, Version}), - Reason = io_lib:format("Not supported: ~p~n", [What]), - error_log(Reason, ModData), + 501, {Method, Uri, Version}, {not_sup, What}), {stop, normal, State#state{response_sent = true}}; {error, {bad_request, {forbidden, URI}}} -> httpd_response:send_status(ModData#mod{http_version = Version}, 403, URI), - Reason = io_lib:format("Forbidden URI: ~p~n", [URI]), - error_log(Reason, ModData), {stop, normal, State#state{response_sent = true}}; {error, {bad_request, {malformed_syntax, URI}}} -> httpd_response:send_status(ModData#mod{http_version = Version}, - 400, URI), - Reason = io_lib:format("Malformed syntax in URI: ~p~n", [URI]), - error_log(Reason, ModData), + 400, URI, {malformed_syntax, URI}), {stop, normal, State#state{response_sent = true}}; {error, {bad_version, Ver}} -> - httpd_response:send_status(ModData#mod{http_version = "HTTP/0.9"}, 400, Ver), - Reason = io_lib:format("Malformed syntax version: ~p~n", [Ver]), - error_log(Reason, ModData), + httpd_response:send_status(ModData#mod{http_version = "HTTP/0.9"}, 400, Ver, {malformed_syntax, Ver}), {stop, normal, State#state{response_sent = true}} end; handle_http_msg(Body, State) -> @@ -497,18 +489,13 @@ handle_body(#state{headers = Headers, body = Body, catch throw:Error -> httpd_response:send_status(ModData, 400, - "Bad input"), - Reason = io_lib:format("Chunk decoding failed: ~p~n", - [Error]), - error_log(Reason, ModData), + "Bad input", {chunk_decoding, bad_input, Error}), {stop, normal, State#state{response_sent = true}} end; Encoding when is_list(Encoding) -> httpd_response:send_status(ModData, 501, - "Unknown Transfer-Encoding"), - Reason = io_lib:format("Unknown Transfer-Encoding: ~p~n", - [Encoding]), - error_log(Reason, ModData), + "Unknown Transfer-Encoding", + {unknown_transfer_encoding, Encoding}), {stop, normal, State#state{response_sent = true}}; _ -> Length = list_to_integer(Headers#http_request_h.'content-length'), @@ -544,7 +531,6 @@ handle_body(#state{headers = Headers, body = Body, end; false -> httpd_response:send_status(ModData, 413, "Body too long"), - error_log("Body too long", ModData), {stop, normal, State#state{response_sent = true}} end end. @@ -559,22 +545,21 @@ handle_expect(#state{headers = Headers, mod = ok; continue when MaxBodySize < Length -> httpd_response:send_status(ModData, 413, "Body too long"), - error_log("Body too long", ModData), {stop, normal, State#state{response_sent = true}}; {break, Value} -> httpd_response:send_status(ModData, 417, - "Unexpected expect value"), - Reason = io_lib:format("Unexpected expect value: ~p~n", [Value]), - error_log(Reason, ModData), + "Unexpected expect value", + {unexpected, Value} + ), {stop, normal, State#state{response_sent = true}}; no_expect_header -> ok; http_1_0_expect_header -> httpd_response:send_status(ModData, 400, "Only HTTP/1.1 Clients " - "may use the Expect Header"), - error_log("Client with lower version than 1.1 tried to send" - "an expect header", ModData), + "may use the Expect Header", + "Client with lower version than 1.1 tried to send" + "an expect header"), {stop, normal, State#state{response_sent = true}} end. @@ -732,13 +717,7 @@ decrease(N) when is_integer(N) -> decrease(N) -> N. -error_log(ReasonString, #mod{config_db = ConfigDB}) -> - Error = lists:flatten( - io_lib:format("Error reading request: ~s", [ReasonString])), - httpd_util:error_log(ConfigDB, Error). - - -%%-------------------------------------------------------------------- +%-------------------------------------------------------------------- %% Config access wrapper functions %%-------------------------------------------------------------------- diff --git a/lib/inets/src/http_server/httpd_response.erl b/lib/inets/src/http_server/httpd_response.erl index bb946664f9..7b204e12ad 100644 --- a/lib/inets/src/http_server/httpd_response.erl +++ b/lib/inets/src/http_server/httpd_response.erl @@ -19,7 +19,7 @@ %% %% -module(httpd_response). --export([generate_and_send_response/1, send_status/3, send_header/3, +-export([generate_and_send_response/1, send_status/3, send_status/4, send_header/3, send_body/3, send_chunk/3, send_final_chunk/2, send_final_chunk/3, split_header/2, is_disable_chunked_send/1, cache_headers/2, handle_continuation/1]). -export([map_status_code/2]). @@ -28,6 +28,7 @@ -include_lib("inets/include/httpd.hrl"). -include_lib("inets/src/http_lib/http_internal.hrl"). -include_lib("inets/src/http_server/httpd_internal.hrl"). +-include_lib("kernel/include/logger.hrl"). -define(VMODULE,"RESPONSE"). @@ -48,7 +49,7 @@ generate_and_send_response(#mod{config_db = ConfigDB} = ModData) -> ok; {proceed, Data} -> case proplists:get_value(status, Data) of - {StatusCode, PhraseArgs, _Reason} -> + {StatusCode, PhraseArgs, _Reason} -> send_status(ModData, StatusCode, PhraseArgs), ok; undefined -> @@ -89,14 +90,12 @@ traverse_modules(ModData,[Module|Rest]) -> traverse_modules(ModData#mod{data = NewData}, Rest) catch T:E:Stacktrace -> - String = - lists:flatten( - io_lib:format("module traverse failed: ~p:do => " - "~n Error Type: ~p" - "~n Error: ~p" - "~n Stack trace: ~p", - [Module, T, E, Stacktrace])), - httpd_util:error_log(ModData#mod.config_db, String), + httpd_util:error_log(ModData#mod.config_db, + httpd_logger:error_report('HTTP', + [{module, Module}, + {class, T}, + {error, E}, + {stacktrace, Stacktrace}], ModData, ?LOCATION)), send_status(ModData, 500, none), done end. @@ -107,9 +106,12 @@ traverse_modules(ModData,[Module|Rest]) -> send_status(ModData, 100, _PhraseArgs) -> send_header(ModData, 100, [{content_length, "0"}]); +send_status(ModData, StatusCode, PhraseArgs) -> + send_status(ModData, StatusCode, PhraseArgs, undefined). + send_status(#mod{socket_type = SocketType, socket = Socket, - config_db = ConfigDB} = ModData, StatusCode, PhraseArgs) -> + config_db = ConfigDB} = ModData, StatusCode, PhraseArgs, Details) -> ReasonPhrase = httpd_util:reason_phrase(StatusCode), Message = httpd_util:message(StatusCode, PhraseArgs, ConfigDB), @@ -119,6 +121,21 @@ send_status(#mod{socket_type = SocketType, [{content_type, "text/html"}, {content_length, integer_to_list(length(Body))}]), + if StatusCode >= 400 -> + case Details of + undefined -> + httpd_util:error_log(ConfigDB, httpd_logger:error_report('HTTP', + [{statuscode, StatusCode}, {description, ReasonPhrase}], + ModData, ?LOCATION)); + _ -> + httpd_util:error_log(ConfigDB, httpd_logger:error_report('HTTP', + [{statuscode,StatusCode}, {description, ReasonPhrase}, + {details, Details}], ModData, + ?LOCATION)) + end; + true -> + ok + end, httpd_socket:deliver(SocketType, Socket, Body). diff --git a/lib/inets/src/http_server/httpd_util.erl b/lib/inets/src/http_server/httpd_util.erl index 4a2eff4770..6b3b2c9660 100644 --- a/lib/inets/src/http_server/httpd_util.erl +++ b/lib/inets/src/http_server/httpd_util.erl @@ -35,6 +35,7 @@ -export([encode_hex/1, decode_hex/1]). -include_lib("kernel/include/file.hrl"). +-include_lib("inets/include/httpd.hrl"). ip_address({_,_,_,_} = Address, _IpFamily) -> {ok, Address}; @@ -762,16 +763,33 @@ do_enable_debug([{Level,Modules}|Rest]) end, do_enable_debug(Rest). -error_log(ConfigDb, Error) -> - error_log(mod_log, ConfigDb, Error), - error_log(mod_disk_log, ConfigDb, Error). - -error_log(Mod, ConfigDB, Error) -> + +error_log(ConfigDB, Report) -> + case lookup(ConfigDB, logger) of + undefined -> + mod_error_logging(mod_log, ConfigDB, Report), + mod_error_logging(mod_disk_log, ConfigDB, Report); + Logger -> + Domain = proplists:get_value(error, Logger), + httpd_logger:log(error, Report, Domain), + %% Backwards compat + mod_error_logging(mod_log, ConfigDB, Report), + mod_error_logging(mod_disk_log, ConfigDB, Report) + end. + +mod_error_logging(Mod, ConfigDB, Report) -> Modules = httpd_util:lookup(ConfigDB, modules, [mod_get, mod_head, mod_log]), case lists:member(Mod, Modules) of true -> - Mod:report_error(ConfigDB, Error); + %% Make it oneline string for backwards compatibility + Msg = httpd_logger:format(Report), + ErrorStr = lists:flatten(logger_formatter:format(#{level => error, + msg => Msg, + meta => #{} + }, + #{template => [msg]})), + Mod:report_error(ConfigDB, ErrorStr); _ -> ok end. diff --git a/lib/inets/src/http_server/mod_alias.erl b/lib/inets/src/http_server/mod_alias.erl index 68a3de0229..fac59ab93c 100644 --- a/lib/inets/src/http_server/mod_alias.erl +++ b/lib/inets/src/http_server/mod_alias.erl @@ -37,7 +37,6 @@ %% do do(#mod{data = Data} = Info) -> - ?hdrt("do", []), case proplists:get_value(status, Data) of %% A status code has been generated! {_StatusCode, _PhraseArgs, _Reason} -> @@ -60,17 +59,11 @@ do_alias(#mod{config_db = ConfigDB, data = Data}) -> {ShortPath, Path, AfterPath} = real_name(ConfigDB, ReqURI, which_alias(ConfigDB)), - ?hdrt("real name", - [{request_uri, ReqURI}, - {short_path, ShortPath}, - {path, Path}, - {after_path, AfterPath}]), %% Relocate if a trailing slash is missing else proceed! LastChar = lists:last(ShortPath), case file:read_file_info(ShortPath) of {ok, FileInfo} when ((FileInfo#file_info.type =:= directory) andalso (LastChar =/= $/)) -> - ?hdrt("directory and last-char is a /", []), ServerName = which_server_name(ConfigDB), Port = port_string(which_port(ConfigDB)), Protocol = get_protocol(SocketType), diff --git a/lib/inets/src/http_server/mod_dir.erl b/lib/inets/src/http_server/mod_dir.erl index ba93d0b271..2a90575e7d 100644 --- a/lib/inets/src/http_server/mod_dir.erl +++ b/lib/inets/src/http_server/mod_dir.erl @@ -28,7 +28,6 @@ %% do do(Info) -> - ?DEBUG("do -> entry",[]), case Info#mod.method of "GET" -> case proplists:get_value(status, Info#mod.data) of @@ -52,7 +51,6 @@ do(Info) -> end. do_dir(Info) -> - ?DEBUG("do_dir -> Request URI: ~p",[Info#mod.request_uri]), Path = mod_alias:path(Info#mod.data,Info#mod.config_db, Info#mod.request_uri), DefaultPath = mod_alias:default_index(Info#mod.config_db,Path), @@ -61,11 +59,6 @@ do_dir(Info) -> {ok,FileInfo} when FileInfo#file_info.type == directory -> DecodedRequestURI = http_uri:decode(Info#mod.request_uri), - ?DEBUG("do_dir -> ~n" - " Path: ~p~n" - " DefaultPath: ~p~n" - " DecodedRequestURI: ~p", - [Path,DefaultPath,DecodedRequestURI]), case dir(DefaultPath,string:strip(DecodedRequestURI,right,$/), Info#mod.config_db) of {ok, Dir} -> @@ -85,21 +78,13 @@ do_dir(Info) -> {proceed,[{response,{response, Head, Dir}}, {mime_type,"text/html"} | Info#mod.data]}; {error, Reason} -> - ?ERROR("do_dir -> dir operation failed: ~p",[Reason]), {proceed, [{status,{404,Info#mod.request_uri,Reason}}| Info#mod.data]} end; {ok, _FileInfo} -> - ?DEBUG("do_dir -> ~n" - " Path: ~p~n" - " DefaultPath: ~p~n" - " FileInfo: ~p", - [Path,DefaultPath,FileInfo]), {proceed,Info#mod.data}; {error,Reason} -> - ?LOG("do_dir -> failed reading file info (~p) for: ~p", - [Reason,DefaultPath]), Status = httpd_file:handle_error(Reason, "access", Info, DefaultPath), {proceed, [{status, Status}| Info#mod.data]} diff --git a/lib/inets/src/http_server/mod_esi.erl b/lib/inets/src/http_server/mod_esi.erl index 8cbd9798e6..112e74575d 100644 --- a/lib/inets/src/http_server/mod_esi.erl +++ b/lib/inets/src/http_server/mod_esi.erl @@ -31,6 +31,7 @@ -include("httpd.hrl"). -include("httpd_internal.hrl"). +-include_lib("kernel/include/logger.hrl"). -define(VMODULE,"ESI"). -define(DEFAULT_ERL_TIMEOUT,15). @@ -345,12 +346,12 @@ erl_scheme_webpage_whole(Mod, Func, Env, Input, ModData) -> integer_to_list(Length)}| NewHeaders]), case ModData#mod.method of "HEAD" -> - {proceed, [{response, {already_sent, 200, 0}} | + {proceed, [{response, {already_sent, StatusCode, 0}} | ModData#mod.data]}; _ -> httpd_response:send_body(ModData, StatusCode, Body), - {proceed, [{response, {already_sent, 200, + {proceed, [{response, {already_sent, StatusCode, Length}} | ModData#mod.data]} end @@ -415,12 +416,12 @@ deliver_webpage_chunk(#mod{config_db = Db} = ModData, Pid, Timeout) -> [{"transfer-encoding", "chunked"} | NewHeaders]) end, - handle_body(Pid, ModData, Body, Timeout, length(Body), + handle_body(Pid, ModData, Body, Timeout, length(Body), StatusCode, IsDisableChunkedSend); timeout -> send_headers(ModData, 504, [{"connection", "close"}]), httpd_socket:close(ModData#mod.socket_type, ModData#mod.socket), - {proceed,[{response, {already_sent, 200, 0}} | ModData#mod.data]} + {proceed,[{response, {already_sent, 504, 0}} | ModData#mod.data]} end. receive_headers(Timeout) -> @@ -444,28 +445,29 @@ send_headers(ModData, StatusCode, HTTPHeaders) -> httpd_response:send_header(ModData, StatusCode, ExtraHeaders ++ HTTPHeaders). -handle_body(_, #mod{method = "HEAD"} = ModData, _, _, Size, _) -> - {proceed, [{response, {already_sent, 200, Size}} | ModData#mod.data]}; +handle_body(_, #mod{method = "HEAD"} = ModData, _, _, Size, StatusCode, _) -> + {proceed, [{response, {already_sent, StatusCode, Size}} | ModData#mod.data]}; -handle_body(Pid, ModData, Body, Timeout, Size, IsDisableChunkedSend) -> +handle_body(Pid, ModData, Body, Timeout, Size, StatusCode, IsDisableChunkedSend) -> httpd_response:send_chunk(ModData, Body, IsDisableChunkedSend), receive {esi_data, Data} when is_binary(Data) -> - handle_body(Pid, ModData, Data, Timeout, Size + byte_size(Data), + handle_body(Pid, ModData, Data, Timeout, Size + byte_size(Data), StatusCode, IsDisableChunkedSend); {esi_data, Data} -> - handle_body(Pid, ModData, Data, Timeout, Size + length(Data), + handle_body(Pid, ModData, Data, Timeout, Size + length(Data), StatusCode, IsDisableChunkedSend); {ok, Data} -> - handle_body(Pid, ModData, Data, Timeout, Size + length(Data), + handle_body(Pid, ModData, Data, Timeout, Size + length(Data), StatusCode, IsDisableChunkedSend); {'EXIT', Pid, normal} when is_pid(Pid) -> httpd_response:send_final_chunk(ModData, IsDisableChunkedSend), - {proceed, [{response, {already_sent, 200, Size}} | + {proceed, [{response, {already_sent, StatusCode, Size}} | ModData#mod.data]}; {'EXIT', Pid, Reason} when is_pid(Pid) -> - Error = lists:flatten(io_lib:format("mod_esi process failed with reason ~p", [Reason])), - httpd_util:error_log(ModData#mod.config_db, Error), + httpd_util:error_log(ModData#mod.config_db, + httpd_logger:error_report('HTTP', + [{mod_esi, Reason}], ModData, ?LOCATION)), httpd_response:send_final_chunk(ModData, [{"Warning", "199 inets server - body maybe incomplete, " "internal server error"}], diff --git a/lib/inets/src/http_server/mod_get.erl b/lib/inets/src/http_server/mod_get.erl index 58600f5e3e..f615e8d3fa 100644 --- a/lib/inets/src/http_server/mod_get.erl +++ b/lib/inets/src/http_server/mod_get.erl @@ -32,7 +32,6 @@ %% do do(Info) -> - ?DEBUG("do -> entry",[]), case Info#mod.method of "GET" -> case proplists:get_value(status, Info#mod.data) of @@ -57,7 +56,6 @@ do(Info) -> do_get(Info) -> - ?DEBUG("do_get -> Request URI: ~p",[Info#mod.request_uri]), Path = mod_alias:path(Info#mod.data, Info#mod.config_db, Info#mod.request_uri), @@ -71,7 +69,6 @@ send_response(_Socket, _SocketType, Path, Info)-> case file:open(Path,[raw,binary]) of {ok, FileDescriptor} -> {FileInfo, LastModified} = get_modification_date(Path), - ?DEBUG("do_get -> FileDescriptor: ~p",[FileDescriptor]), Suffix = httpd_util:suffix(Path), MimeType = httpd_util:lookup_mime_default(Info#mod.config_db, Suffix,"text/plain"), @@ -94,8 +91,6 @@ send_response(_Socket, _SocketType, Path, Info)-> FileInfo#file_info.size}}, {mime_type,MimeType} | Info#mod.data]}; {error, Reason} -> - ?hdrt("send_response -> failed open file", - [{path, Path}, {reason, Reason}]), Status = httpd_file:handle_error(Reason, "open", Info, Path), {proceed, [{status, Status} | Info#mod.data]} end. @@ -104,7 +99,6 @@ send_response(_Socket, _SocketType, Path, Info)-> send(#mod{socket = Socket, socket_type = SocketType} = Info, StatusCode, Headers, FileDescriptor) -> - ?DEBUG("send -> send header",[]), httpd_response:send_header(Info, StatusCode, Headers), send_body(SocketType,Socket,FileDescriptor). @@ -112,16 +106,13 @@ send(#mod{socket = Socket, socket_type = SocketType} = Info, send_body(SocketType,Socket,FileDescriptor) -> case file:read(FileDescriptor,?FILE_CHUNK_SIZE) of {ok,Binary} -> - ?DEBUG("send_body -> send another chunk: ~p",[size(Binary)]), case httpd_socket:deliver(SocketType,Socket,Binary) of socket_closed -> - ?LOG("send_body -> socket closed while sending",[]), socket_close; _ -> send_body(SocketType,Socket,FileDescriptor) end; eof -> - ?DEBUG("send_body -> done with this file",[]), eof end. diff --git a/lib/inets/src/http_server/mod_range.erl b/lib/inets/src/http_server/mod_range.erl index 1c6c6d927d..36ccdc268a 100644 --- a/lib/inets/src/http_server/mod_range.erl +++ b/lib/inets/src/http_server/mod_range.erl @@ -25,7 +25,6 @@ %% do do(Info) -> - ?DEBUG("do -> entry",[]), case Info#mod.method of "GET" -> case proplists:get_value(status, Info#mod.data) of @@ -66,7 +65,6 @@ do(Info) -> end. do_get_range(Info,Ranges) -> - ?DEBUG("do_get_range -> Request URI: ~p",[Info#mod.request_uri]), Path = mod_alias:path(Info#mod.data, Info#mod.config_db, Info#mod.request_uri), {FileInfo, LastModified} = get_modification_date(Path), @@ -76,7 +74,6 @@ do_get_range(Info,Ranges) -> send_range_response(Path, Info, Ranges, FileInfo, LastModified)-> case parse_ranges(Ranges) of error-> - ?ERROR("send_range_response-> Unparsable range request",[]), {proceed,Info#mod.data}; {multipart,RangeList}-> send_multi_range_response(Path, Info, RangeList); @@ -110,15 +107,12 @@ send_multi_range_response(Path,Info,RangeList)-> case file:open(Path, [raw,binary]) of {ok, FileDescriptor} -> file:close(FileDescriptor), - ?DEBUG("send_multi_range_response -> FileDescriptor: ~p", - [FileDescriptor]), Suffix = httpd_util:suffix(Path), PartMimeType = httpd_util:lookup_mime_default(Info#mod.config_db, Suffix,"text/plain"), {FileInfo, LastModified} = get_modification_date(Path), case valid_ranges(RangeList,Path,FileInfo) of {ValidRanges,true}-> - ?DEBUG("send_multi_range_response ->Ranges are valid:",[]), %Apache breaks the standard by sending the size %field in the Header. Header = @@ -127,8 +121,6 @@ send_multi_range_response(Path,Info,RangeList)-> "=RangeBoundarySeparator"}, {etag, httpd_util:create_etag(FileInfo)} | LastModified], - ?DEBUG("send_multi_range_response -> Valid Ranges: ~p", - [RagneList]), Body = {fun send_multiranges/4, [ValidRanges, Info, PartMimeType, Path]}, {proceed,[{response, @@ -138,12 +130,10 @@ send_multi_range_response(Path,Info,RangeList)-> bad_range_boundaries }}]} end; {error, _Reason} -> - ?ERROR("do_get -> failed open file: ~p",[_Reason]), {proceed,Info#mod.data} end. send_multiranges(ValidRanges,Info,PartMimeType,Path)-> - ?DEBUG("send_multiranges -> Start sending the ranges",[]), case file:open(Path, [raw,binary]) of {ok,FileDescriptor} -> lists:foreach(fun(Range)-> @@ -195,8 +185,6 @@ send_range_response(Path, Info, Start, Stop, FileInfo, LastModified)-> case file:open(Path, [raw,binary]) of {ok, FileDescriptor} -> file:close(FileDescriptor), - ?DEBUG("send_range_response -> FileDescriptor: ~p", - [FileDescriptor]), Suffix = httpd_util:suffix(Path), MimeType = httpd_util:lookup_mime_default(Info#mod.config_db, Suffix,"text/plain"), @@ -219,13 +207,11 @@ send_range_response(Path, Info, Start, Stop, FileInfo, LastModified)-> {proceed, [{status, {416, Reason, bad_range_boundaries }}]} end; {error, _Reason} -> - ?ERROR("send_range_response -> failed open file: ~p",[_Reason]), {proceed,Info#mod.data} end. send_range_body(SocketType,Socket,Path,Start,End) -> - ?DEBUG("mod_range -> send_range_body",[]), case file:open(Path, [raw,binary]) of {ok,FileDescriptor} -> send_part_start(SocketType,Socket,FileDescriptor,Start,End), @@ -268,8 +254,6 @@ send_part(SocketType,Socket,FileDescriptor,End)-> case httpd_socket:deliver(SocketType,Socket, Binary) of socket_closed -> - ?LOG("send_range of body -> socket " - "closed while sending",[]), socket_close; _ -> send_part(SocketType,Socket, @@ -406,15 +390,12 @@ split_range([N|Rest],Current,End) -> send_body(SocketType,Socket,FileDescriptor) -> case file:read(FileDescriptor,?FILE_CHUNK_SIZE) of {ok,Binary} -> - ?DEBUG("send_body -> send another chunk: ~p",[size(Binary)]), case httpd_socket:deliver(SocketType,Socket,Binary) of socket_closed -> - ?LOG("send_body -> socket closed while sending",[]), socket_close; _ -> send_body(SocketType,Socket,FileDescriptor) end; eof -> - ?DEBUG("send_body -> done with this file",[]), eof end. diff --git a/lib/inets/src/http_server/mod_responsecontrol.erl b/lib/inets/src/http_server/mod_responsecontrol.erl index 07129940a5..ca1bde519e 100644 --- a/lib/inets/src/http_server/mod_responsecontrol.erl +++ b/lib/inets/src/http_server/mod_responsecontrol.erl @@ -26,7 +26,6 @@ -include("httpd_internal.hrl"). do(Info) -> - ?DEBUG("do -> response_control",[]), case proplists:get_value(status, Info#mod.data) of %% A status code has been generated! {_StatusCode, _PhraseArgs, _Reason} -> @@ -53,7 +52,6 @@ do(Info) -> %%wheather a response shall be createed or not %%---------------------------------------------------------------------- do_responsecontrol(Info) -> - ?DEBUG("do_response_control -> Request URI: ~p",[Info#mod.request_uri]), Path = mod_alias:path(Info#mod.data, Info#mod.config_db, Info#mod.request_uri), case file:read_file_info(Path) of @@ -220,7 +218,6 @@ compare_etags(Tag,Etags) -> %% Control the If-Modified-Since and If-Not-Modified-Since header fields %%---------------------------------------------------------------------- control_modification(Path,Info,FileInfo)-> - ?DEBUG("control_modification() -> entry",[]), case control_modification_data(Info, FileInfo#file_info.mtime, "if-modified-since") of @@ -260,23 +257,18 @@ control_modification_data(Info, ModificationTime, HeaderField)-> bad_date -> {bad_date, LastModified0}; ConvertedReqDate -> - LastModified = - calendar:universal_time_to_local_time(ConvertedReqDate), - ?DEBUG("control_modification_data() -> " - "~n Request-Field: ~s" - "~n FileLastModified: ~p" - "~n FieldValue: ~p", - [HeaderField, ModificationTime, LastModified]), - FileTime = + LastModified = calendar:universal_time_to_local_time(ConvertedReqDate), + FileTime = calendar:datetime_to_gregorian_seconds(ModificationTime), FieldTime = calendar:datetime_to_gregorian_seconds(LastModified), if FileTime =< FieldTime -> - ?DEBUG("File unmodified~n", []), unmodified; + unmodified; FileTime >= FieldTime -> - ?DEBUG("File modified~n", []), modified + modified end + end end. diff --git a/lib/inets/src/inets_app/inets.app.src b/lib/inets/src/inets_app/inets.app.src index e5780b2a4c..41b2ab950f 100644 --- a/lib/inets/src/inets_app/inets.app.src +++ b/lib/inets/src/inets_app/inets.app.src @@ -66,6 +66,7 @@ httpd_file, httpd_instance_sup, httpd_log, + httpd_logger, httpd_manager, httpd_misc_sup, httpd_request, diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index fc5ca14dcd..1d80d604b7 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -28,6 +28,7 @@ -include_lib("kernel/include/file.hrl"). -include_lib("common_test/include/ct.hrl"). -include_lib("public_key/include/public_key.hrl"). +-include_lib("inets/include/httpd.hrl"). -include("inets_test_lib.hrl"). %% Note: This directive should only be used in test suites. @@ -58,6 +59,7 @@ all() -> {group, https_limit}, {group, http_custom}, {group, https_custom}, + {group, https_custom}, {group, http_basic_auth}, {group, https_basic_auth}, {group, http_auth_api}, @@ -77,6 +79,7 @@ all() -> {group, http_post}, {group, http_rel_path_script_alias}, {group, http_not_sup}, + {group, https_alert}, {group, https_not_sup}, mime_types_format, erl_script_timeout_default, @@ -111,6 +114,7 @@ groups() -> {http_post, [], [{group, post}]}, {http_not_sup, [], [{group, not_sup}]}, {https_not_sup, [], [{group, not_sup}]}, + {https_alert, [], [tls_alert]}, {http_mime_types, [], [alias_1_1, alias_1_0, alias_0_9]}, {limit, [], [max_clients_1_1, max_clients_1_0, max_clients_0_9]}, {custom, [], [customize, add_default]}, @@ -139,7 +143,7 @@ groups() -> {http_1_1, [], [host, chunked, expect, cgi, cgi_chunked_encoding_test, trace, range, if_modified_since, mod_esi_chunk_timeout, - esi_put, esi_post] ++ http_head() ++ http_get() ++ load()}, + esi_put, esi_post, esi_proagate] ++ http_head() ++ http_get() ++ load()}, {http_1_0, [], [host, cgi, trace] ++ http_head() ++ http_get() ++ load()}, {http_0_9, [], http_head() ++ http_get() ++ load()}, {http_rel_path_script_alias, [], [cgi]}, @@ -183,6 +187,9 @@ init_per_suite(Config) -> setup_tmp_dir(PrivDir), setup_server_dirs(ServerRoot, DocRoot, DataDir), {ok, Hostname0} = inet:gethostname(), + logger:add_handler_filter(default, inets_httpd, {fun logger_filters:domain/2, + {log, equal,[otp,inets, httpd, httpd_test, error]}}), + %%logger:set_handler_config(default, formatter, {logger_formatter, #{}}), Inet = case (catch ct:get_config(ipv6_hosts)) of undefined -> @@ -217,7 +224,8 @@ init_per_group(Group, Config0) when Group == https_basic; Group == https_auth_api_mnesia; Group == https_security; Group == https_reload; - Group == https_not_sup + Group == https_not_sup; + Group == https_alert -> catch crypto:stop(), try crypto:start() of @@ -1053,6 +1061,17 @@ mod_esi_chunk_timeout(Config) when is_list(Config) -> proplists:get_value(port, Config), proplists:get_value(host, Config), proplists:get_value(node, Config)). +%%------------------------------------------------------------------------- +esi_proagate(Config) when is_list(Config) -> + register(propagate_test, self()), + ok = http_status("GET /cgi-bin/erl/httpd_example:new_status_and_location ", + Config, [{statuscode, 201}]), + receive + {status, 201} -> + ok; + Err -> + ct:fail(Err) + end. %%------------------------------------------------------------------------- cgi() -> @@ -1908,6 +1927,10 @@ erl_script_timeout_apache(Config) when is_list(Config) -> verify_body(Body, 6000), inets:stop(). +tls_alert(Config) when is_list(Config) -> + SSLOpts = proplists:get_value(client_alert_conf, Config), + Port = proplists:get_value(port, Config), + {error, {tls_alert, _}} = ssl:connect("localhost", Port, [{verify, verify_peer} | SSLOpts]). %%-------------------------------------------------------------------- %% Internal functions ----------------------------------- @@ -2041,7 +2064,8 @@ start_apps(Group) when Group == https_basic; Group == https_htaccess; Group == https_security; Group == https_reload; - Group == https_not_sup + Group == https_not_sup; + Group == https_alert -> inets_test_lib:start_apps([inets, asn1, crypto, public_key, ssl]); start_apps(Group) when Group == http_basic; @@ -2071,7 +2095,7 @@ server_start(_, HttpdConfig) -> init_ssl(Group, Config) -> ClientFileBase = filename:join([proplists:get_value(priv_dir, Config), "client"]), ServerFileBase = filename:join([proplists:get_value(priv_dir, Config), "server"]), - GenCertData = + GenCertData = #{client_config := CConf} = public_key:pkix_test_data(#{server_chain => #{root => [{key, inets_test_lib:hardcode_rsa_key(1)}], intermediates => [[{key, inets_test_lib:hardcode_rsa_key(2)}]], @@ -2081,11 +2105,12 @@ init_ssl(Group, Config) -> #{root => [{key, inets_test_lib:hardcode_rsa_key(4)}], intermediates => [[{key, inets_test_lib:hardcode_rsa_key(5)}]], peer => [{key, inets_test_lib:hardcode_rsa_key(6)}]}}), - + [_ | CAs] = proplists:get_value(cacerts, CConf), + AlertConf = [{cacerts, CAs} | proplists:delete(cacerts, CConf)], Conf = inets_test_lib:gen_pem_config_files(GenCertData, ClientFileBase, ServerFileBase), case start_apps(Group) of ok -> - init_httpd(Group, [{type, ssl}, {ssl_conf, Conf} | Config]); + init_httpd(Group, [{client_alert_conf, AlertConf}, {type, ssl}, {ssl_conf, Conf} | Config]); _ -> {skip, "Could not start https apps"} end. @@ -2157,7 +2182,8 @@ server_config(http_mime_types, Config0) -> ServerRoot = proplists:get_value(server_root, Config0), MimeTypesFile = filename:join([ServerRoot,"config", "mime.types"]), [{mime_types, MimeTypesFile} | proplists:delete(mime_types, Config1)]; - +server_config(https_alert, Config) -> + basic_conf() ++ server_config(https, Config); server_config(http, Config) -> ServerRoot = proplists:get_value(server_root, Config), [{port, 0}, @@ -2246,10 +2272,21 @@ head_status(_) -> basic_conf() -> [{modules, [mod_alias, mod_range, mod_responsecontrol, - mod_trace, mod_esi, mod_cgi, mod_get, mod_head]}]. + mod_trace, mod_esi, ?MODULE, mod_cgi, mod_get, mod_head]}, + {logger, [{error, httpd_test}]}]. + +do(ModData) -> + case whereis(propagate_test) of + undefined -> + ok; + _ -> + {already_sent, Status, _Size} = proplists:get_value(response, ModData#mod.data), + propagate_test ! {status, Status} + end, + {proceed, ModData#mod.data}. not_sup_conf() -> - [{modules, [mod_get]}]. + [{modules, [mod_get]}]. auth_access_conf() -> [{modules, [mod_alias, mod_htaccess, mod_dir, mod_get, mod_head]}, diff --git a/lib/inets/test/httpd_SUITE_data/cgi_echo.c b/lib/inets/test/httpd_SUITE_data/cgi_echo.c index 580f860e96..e90b125a00 100644 --- a/lib/inets/test/httpd_SUITE_data/cgi_echo.c +++ b/lib/inets/test/httpd_SUITE_data/cgi_echo.c @@ -4,6 +4,8 @@ #if defined __WIN32__ #include <windows.h> #include <fcntl.h> +#else +#include <unistd.h> #endif static int read_exact(char *buffer, int len); diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index fd248e793a..9ae7f5b91e 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 7.0.7 +INETS_VSN = 7.0.7.2 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/doc/src/gen_udp.xml b/lib/kernel/doc/src/gen_udp.xml index d20fc1fdfd..6ffcfd9af3 100644 --- a/lib/kernel/doc/src/gen_udp.xml +++ b/lib/kernel/doc/src/gen_udp.xml @@ -213,12 +213,93 @@ </func> <func> - <name name="send" arity="4" since=""/> + <name name="send" arity="3" since="OTP 21.3.8.4"/> <fsummary>Send a packet.</fsummary> <desc> <p> - Sends a packet to the specified address and port. Argument - <c><anno>Address</anno></c> can be a hostname or a socket address. + Sends a packet to the specified <c><anno>Destination</anno></c>. + </p> + <p> + This function is equivalent to + <seealso marker="#send-4-AncData"><c>send(<anno>Socket</anno>, <anno>Destination</anno>, [], <anno>Packet</anno>)</c></seealso>. + </p> + </desc> + </func> + + <func> + <name name="send" arity="4" clause_i="1" since=""/> + <fsummary>Send a packet.</fsummary> + <desc> + <p> + Sends a packet to the specified <c><anno>Host</anno></c> + and <c><anno>Port</anno></c>. + </p> + <p> + This clause is equivalent to + <seealso marker="#send/5"><c>send(<anno>Socket</anno>, <anno>Host</anno>, <anno>Port</anno>, [], <anno>Packet</anno>)</c></seealso>. + </p> + </desc> + </func> + + <func> + <name name="send" arity="4" clause_i="2" anchor="send-4-AncData" since="OTP 21.3.8.4"/> + <fsummary>Send a packet.</fsummary> + <desc> + <p> + Sends a packet to the specified <c><anno>Destination</anno></c> + with ancillary data <c><anno>AncData</anno></c>. + </p> + <note> + <p> + The ancillary data <c><anno>AncData</anno></c> + contains options that for this single message + override the default options for the socket, + an operation that may not be supported on all platforms, + and if so return <c>{error, einval}</c>. + Using more than one of an ancillary data item type + may also not be supported. + <c><anno>AncData</anno> =:= []</c> is always supported. + </p> + </note> + </desc> + </func> + + <func> + <name name="send" arity="4" clause_i="3" since="OTP 21.3.8.4"/> + <fsummary>Send a packet.</fsummary> + <desc> + <p> + Sends a packet to the specified <c><anno>Destination</anno></c>. + Since <c><anno>Destination</anno></c> is complete, + <c><anno>PortZero</anno></c> is redundant and has to be <c>0</c>. + </p> + <p> + This is a legacy clause mostly for + <c><anno>Destination</anno> = {local, Binary}</c> + where <c><anno>PortZero</anno></c> is superfluous. + It is equivalent to + <seealso marker="#send-4-AncData"><c>send(<anno>Socket</anno>, <anno>Destination</anno>, [], <anno>Packet</anno>)</c></seealso>, the clause right above here. + </p> + </desc> + </func> + + <func> + <name name="send" arity="5" since="OTP 21.3.8.4"/> + <fsummary>Send a packet.</fsummary> + <desc> + <p> + Sends a packet to the specified <c><anno>Host</anno></c> + and <c><anno>Port</anno></c>, + with ancillary data <c><anno>AncData</anno></c>. + </p> + <p> + Argument <c><anno>Host</anno></c> can be + a hostname or a socket address, + and <c><anno>Port</anno></c> can be a port number + or a service name atom. + These are resolved into a <c>Destination</c> and after that + this function is equivalent to + <seealso marker="#send-4-AncData"><c>send(<anno>Socket</anno>, Destination, <anno>AncData</anno>, <anno>Packet</anno>)</c></seealso>, read there about ancillary data. </p> </desc> </func> diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml index 5e33bbc3ff..86f76fc07f 100644 --- a/lib/kernel/doc/src/inet.xml +++ b/lib/kernel/doc/src/inet.xml @@ -118,6 +118,42 @@ fe80::204:acff:fe17:bf38 <name name="port_number"/> </datatype> <datatype> + <name name="family_address" since="OTP 21.3.8.4"/> + <desc> + <p> + A general address format on the form <c>{Family, Destination}</c> + where <c>Family</c> is an atom such as <c>local</c> + and the format of <c>Destination</c> depends on <c>Family</c>, + and is a complete address + (for example an IP address including port number). + </p> + </desc> + </datatype> + <datatype> + <name name="inet_address" since="OTP 21.3.8.4"/> + <desc> + <warning> + <p> + This address format is for now experimental + and for completeness to make all address families have a + <c>{Family, Destination}</c> representation. + </p> + </warning> + </desc> + </datatype> + <datatype> + <name name="inet6_address" since="OTP 21.3.8.4"/> + <desc> + <warning> + <p> + This address format is for now experimental + and for completeness to make all address families have a + <c>{Family, Destination}</c> representation. + </p> + </warning> + </desc> + </datatype> + <datatype> <name name="local_address"/> <desc> <p> @@ -180,12 +216,16 @@ fe80::204:acff:fe17:bf38 <name name="ancillary_data"/> <desc> <p> - Ancillary data received with the data packet - or read with the socket option + Ancillary data received with the data packet, + read with the socket option <seealso marker="gen_tcp#type-pktoptions_value"> <c>pktoptions</c> </seealso> - from a TCP socket. + from a TCP socket, + or to set in a call to + <seealso marker="gen_udp#send-4-AncData"><c>gen_udp:send/4</c></seealso> + or + <seealso marker="gen_udp#send/5"><c>gen_udp:send/5</c></seealso>. </p> <p> The value(s) correspond to the currently active socket @@ -193,7 +233,9 @@ fe80::204:acff:fe17:bf38 <seealso marker="inet#option-recvtos"><c>recvtos</c></seealso>, <seealso marker="inet#option-recvtclass"><c>recvtclass</c></seealso> and - <seealso marker="inet#option-recvttl"><c>recvttl</c></seealso>. + <seealso marker="inet#option-recvttl"><c>recvttl</c></seealso>, + or for a single send operation the option(s) to override + the currently active socket option(s). </p> </desc> </datatype> diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml index 61bd598145..30941840ec 100644 --- a/lib/kernel/doc/src/notes.xml +++ b/lib/kernel/doc/src/notes.xml @@ -31,6 +31,55 @@ </header> <p>This document describes the changes made to the Kernel application.</p> +<section><title>Kernel 6.3.1.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix bug where the log file in <c>logger_std_h</c> would + not be closed when the inode of the file changed. This + would in turn cause a file descriptor leak when tools + like logrotate are used.</p> + <p> + Own Id: OTP-15997 Aux Id: PR-2331 </p> + </item> + </list> + </section> + +</section> + +<section><title>Kernel 6.3.1.2</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The possibility to send ancillary data, in particular the + TOS field, has been added to <c>gen_udp:send/4,5</c>.</p> + <p> + Own Id: OTP-15747 Aux Id: ERIERL-294 </p> + </item> + </list> + </section> + +</section> + +<section><title>Kernel 6.3.1.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix type spec for <c>seq_trace:set_token/2</c>.</p> + <p> + Own Id: OTP-15858 Aux Id: ERL-700 </p> + </item> + </list> + </section> + +</section> + <section><title>Kernel 6.3.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/kernel/src/gen_udp.erl b/lib/kernel/src/gen_udp.erl index d6e8652e77..247ebc50f3 100644 --- a/lib/kernel/src/gen_udp.erl +++ b/lib/kernel/src/gen_udp.erl @@ -20,7 +20,7 @@ -module(gen_udp). -export([open/1, open/2, close/1]). --export([send/2, send/4, recv/2, recv/3, connect/3]). +-export([send/2, send/3, send/4, send/5, recv/2, recv/3, connect/3]). -export([controlling_process/2]). -export([fdopen/2]). @@ -125,20 +125,80 @@ open(Port, Opts0) -> close(S) -> inet:udp_close(S). --spec send(Socket, Address, Port, Packet) -> ok | {error, Reason} when +-spec send(Socket, Destination, Packet) -> ok | {error, Reason} when Socket :: socket(), - Address :: inet:socket_address() | inet:hostname(), - Port :: inet:port_number(), + Destination :: {inet:ip_address(), inet:port_number()} | + inet:family_address(), + Packet :: iodata(), + Reason :: not_owner | inet:posix(). +%%% +send(Socket, Destination, Packet) -> + send(Socket, Destination, [], Packet). + +-spec send(Socket, Host, Port, Packet) -> ok | {error, Reason} when + Socket :: socket(), + Host :: inet:hostname() | inet:ip_address(), + Port :: inet:port_number() | atom(), + Packet :: iodata(), + Reason :: not_owner | inet:posix(); +%%% + (Socket, Destination, AncData, Packet) -> ok | {error, Reason} when + Socket :: socket(), + Destination :: {inet:ip_address(), inet:port_number()} | + inet:family_address(), + AncData :: inet:ancillary_data(), + Packet :: iodata(), + Reason :: not_owner | inet:posix(); +%%% + (Socket, Destination, PortZero, Packet) -> ok | {error, Reason} when + Socket :: socket(), + Destination :: {inet:ip_address(), inet:port_number()} | + inet:family_address(), + PortZero :: inet:port_number(), Packet :: iodata(), Reason :: not_owner | inet:posix(). +%%% +send(S, {_,_} = Destination, PortZero = AncData, Packet) when is_port(S) -> + %% Destination is {Family,Addr} | {IP,Port}, + %% so it is complete - argument PortZero is redundant + if + PortZero =:= 0 -> + case inet_db:lookup_socket(S) of + {ok, Mod} -> + Mod:send(S, Destination, [], Packet); + Error -> + Error + end; + is_integer(PortZero) -> + %% Redundant PortZero; must be 0 + {error, einval}; + is_list(AncData) -> + case inet_db:lookup_socket(S) of + {ok, Mod} -> + Mod:send(S, Destination, AncData, Packet); + Error -> + Error + end + end; +send(S, Host, Port, Packet) when is_port(S) -> + send(S, Host, Port, [], Packet). -send(S, Address, Port, Packet) when is_port(S) -> +-spec send(Socket, Host, Port, AncData, Packet) -> ok | {error, Reason} when + Socket :: socket(), + Host :: inet:hostname() | inet:ip_address() | inet:local_address(), + Port :: inet:port_number() | atom(), + AncData :: inet:ancillary_data(), + Packet :: iodata(), + Reason :: not_owner | inet:posix(). +%%% +send(S, Host, Port, AncData, Packet) + when is_port(S), is_list(AncData) -> case inet_db:lookup_socket(S) of {ok, Mod} -> - case Mod:getaddr(Address) of + case Mod:getaddr(Host) of {ok,IP} -> case Mod:getserv(Port) of - {ok,UP} -> Mod:send(S, IP, UP, Packet); + {ok,P} -> Mod:send(S, {IP,P}, AncData, Packet); {error,einval} -> exit(badarg); Error -> Error end; @@ -149,6 +209,7 @@ send(S, Address, Port, Packet) when is_port(S) -> Error end. +%% Connected send send(S, Packet) when is_port(S) -> case inet_db:lookup_socket(S) of {ok, Mod} -> diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index 9f22eb6aaa..7940903658 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -75,7 +75,8 @@ -export_type([address_family/0, socket_protocol/0, hostent/0, hostname/0, ip4_address/0, ip6_address/0, ip_address/0, port_number/0, - local_address/0, socket_address/0, returned_non_ip_address/0, + family_address/0, local_address/0, + socket_address/0, returned_non_ip_address/0, socket_setopt/0, socket_getopt/0, ancillary_data/0, posix/0, socket/0, stat_option/0]). %% imports @@ -100,11 +101,16 @@ 0..65535,0..65535,0..65535,0..65535}. -type ip_address() :: ip4_address() | ip6_address(). -type port_number() :: 0..65535. --type local_address() :: {local, File :: binary() | string()}. +-type family_address() :: inet_address() | inet6_address() | local_address(). +-type inet_address() :: + {'inet', {ip4_address() | 'any' | 'loopback', port_number()}}. +-type inet6_address() :: + {'inet6', {ip6_address() | 'any' | 'loopback', port_number()}}. +-type local_address() :: {'local', File :: binary() | string()}. -type returned_non_ip_address() :: - {local, binary()} | - {unspec, <<>>} | - {undefined, any()}. + {'local', binary()} | + {'unspec', <<>>} | + {'undefined', any()}. -type posix() :: 'eaddrinuse' | 'eaddrnotavail' | 'eafnosupport' | 'ealready' | 'econnaborted' | 'econnrefused' | 'econnreset' | diff --git a/lib/kernel/src/inet6_udp.erl b/lib/kernel/src/inet6_udp.erl index 71db0357cd..cb95a69798 100644 --- a/lib/kernel/src/inet6_udp.erl +++ b/lib/kernel/src/inet6_udp.erl @@ -65,16 +65,25 @@ open(Port, Opts) -> {ok, _} -> exit(badarg) end. -send(S, Addr = {A,B,C,D,E,F,G,H}, P, Data) - when ?ip6(A,B,C,D,E,F,G,H), ?port(P) -> - prim_inet:sendto(S, Addr, P, Data). +send(S, {A,B,C,D,E,F,G,H} = IP, Port, Data) + when ?ip6(A,B,C,D,E,F,G,H), ?port(Port) -> + prim_inet:sendto(S, {IP, Port}, [], Data); +send(S, {{A,B,C,D,E,F,G,H}, Port} = Addr, AncData, Data) + when ?ip6(A,B,C,D,E,F,G,H), ?port(Port), is_list(AncData) -> + prim_inet:sendto(S, Addr, AncData, Data); +send(S, {?FAMILY, {{A,B,C,D,E,F,G,H}, Port}} = Address, AncData, Data) + when ?ip6(A,B,C,D,E,F,G,H), ?port(Port), is_list(AncData) -> + prim_inet:sendto(S, Address, AncData, Data); +send(S, {?FAMILY, {loopback, Port}} = Address, AncData, Data) + when ?port(Port), is_list(AncData) -> + prim_inet:sendto(S, Address, AncData, Data). send(S, Data) -> - prim_inet:sendto(S, {0,0,0,0,0,0,0,0}, 0, Data). + prim_inet:sendto(S, {any, 0}, [], Data). -connect(S, Addr = {A,B,C,D,E,F,G,H}, P) - when ?ip6(A,B,C,D,E,F,G,H), ?port(P) -> - prim_inet:connect(S, Addr, P). +connect(S, Addr = {A,B,C,D,E,F,G,H}, Port) + when ?ip6(A,B,C,D,E,F,G,H), ?port(Port) -> + prim_inet:connect(S, Addr, Port). recv(S, Len) -> prim_inet:recvfrom(S, Len). diff --git a/lib/kernel/src/inet_udp.erl b/lib/kernel/src/inet_udp.erl index 1e624b9e90..083059a2dc 100644 --- a/lib/kernel/src/inet_udp.erl +++ b/lib/kernel/src/inet_udp.erl @@ -66,16 +66,25 @@ open(Port, Opts) -> {ok, _} -> exit(badarg) end. -send(S, {A,B,C,D} = Addr, P, Data) - when ?ip(A,B,C,D), ?port(P) -> - prim_inet:sendto(S, Addr, P, Data). +send(S, {A,B,C,D} = IP, Port, Data) + when ?ip(A,B,C,D), ?port(Port) -> + prim_inet:sendto(S, {IP, Port}, [], Data); +send(S, {{A,B,C,D}, Port} = Addr, AncData, Data) + when ?ip(A,B,C,D), ?port(Port), is_list(AncData) -> + prim_inet:sendto(S, Addr, AncData, Data); +send(S, {?FAMILY, {{A,B,C,D}, Port}} = Address, AncData, Data) + when ?ip(A,B,C,D), ?port(Port), is_list(AncData) -> + prim_inet:sendto(S, Address, AncData, Data); +send(S, {?FAMILY, {loopback, Port}} = Address, AncData, Data) + when ?port(Port), is_list(AncData) -> + prim_inet:sendto(S, Address, AncData, Data). send(S, Data) -> - prim_inet:sendto(S, {0,0,0,0}, 0, Data). + prim_inet:sendto(S, {any, 0}, [], Data). -connect(S, Addr = {A,B,C,D}, P) - when ?ip(A,B,C,D), ?port(P) -> - prim_inet:connect(S, Addr, P). +connect(S, Addr = {A,B,C,D}, Port) + when ?ip(A,B,C,D), ?port(Port) -> + prim_inet:connect(S, Addr, Port). recv(S, Len) -> prim_inet:recvfrom(S, Len). diff --git a/lib/kernel/src/kernel.appup.src b/lib/kernel/src/kernel.appup.src index aca3247c8f..dd1879435d 100644 --- a/lib/kernel/src/kernel.appup.src +++ b/lib/kernel/src/kernel.appup.src @@ -45,7 +45,8 @@ {<<"^6\\.2\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, {<<"^6\\.3$">>,[restart_new_emulator]}, - {<<"^6\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}], + {<<"^6\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^6\\.3\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}], [{<<"^5\\.3$">>,[restart_new_emulator]}, {<<"^5\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^5\\.3\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, @@ -64,4 +65,5 @@ {<<"^6\\.2\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, {<<"^6\\.3$">>,[restart_new_emulator]}, - {<<"^6\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}]}. + {<<"^6\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^6\\.3\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}. diff --git a/lib/kernel/src/local_udp.erl b/lib/kernel/src/local_udp.erl index 481a8c4910..933e56228b 100644 --- a/lib/kernel/src/local_udp.erl +++ b/lib/kernel/src/local_udp.erl @@ -70,11 +70,13 @@ open(0, Opts) -> {ok, _} -> exit(badarg) end. -send(S, Addr = {?FAMILY,_}, 0, Data) -> - prim_inet:sendto(S, Addr, 0, Data). +send(S, {?FAMILY,_} = Addr, 0, Data) -> + prim_inet:sendto(S, Addr, [], Data); +send(S, {?FAMILY,_} = Addr, AncData, Data) when is_list(AncData) -> + prim_inet:sendto(S, Addr, AncData, Data). %% send(S, Data) -> - prim_inet:sendto(S, {?FAMILY,<<>>}, 0, Data). + prim_inet:sendto(S, {?FAMILY,<<>>}, [], Data). connect(S, Addr = {?FAMILY,_}, 0) -> prim_inet:connect(S, Addr, 0). diff --git a/lib/kernel/src/logger_std_h.erl b/lib/kernel/src/logger_std_h.erl index c8f1acfca4..0e46257f99 100644 --- a/lib/kernel/src/logger_std_h.erl +++ b/lib/kernel/src/logger_std_h.erl @@ -455,12 +455,12 @@ maybe_ensure_file(State) -> %% In order to play well with tools like logrotate, we need to be able %% to re-create the file if it has disappeared (e.g. if rotated by %% logrotate) -ensure_file(#{fd:=Fd0,inode:=INode0,file_name:=FileName,modes:=Modes}=State) -> +ensure_file(#{inode:=INode0,file_name:=FileName,modes:=Modes}=State) -> case file:read_file_info(FileName,[raw]) of {ok,#file_info{inode=INode0}} -> State#{last_check=>timestamp()}; _ -> - close_log_file(Fd0), + close_log_file(State), case file:open(FileName,Modes) of {ok,Fd} -> {ok,#file_info{inode=INode}} = diff --git a/lib/kernel/src/seq_trace.erl b/lib/kernel/src/seq_trace.erl index 4f9d7b3e5c..f0bd1fabe9 100644 --- a/lib/kernel/src/seq_trace.erl +++ b/lib/kernel/src/seq_trace.erl @@ -59,7 +59,7 @@ set_token({Flags,Label,Serial,_From,Lastcnt}) -> F = decode_flags(Flags), set_token2([{label,Label},{serial,{Lastcnt, Serial}} | F]). --spec set_token(Component, Val) -> {Component, OldVal} when +-spec set_token(Component, Val) -> OldVal when Component :: component(), Val :: value(), OldVal :: value(). diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index 52edfaee29..dd02ab71dd 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -36,7 +36,8 @@ show_econnreset_passive/1, econnreset_after_sync_send/1, econnreset_after_async_send_active/1, econnreset_after_async_send_active_once/1, - econnreset_after_async_send_passive/1, linger_zero/1, + econnreset_after_async_send_passive/1, + linger_zero/1, linger_zero_sndbuf/1, default_options/1, http_bad_packet/1, busy_send/1, busy_disconnect_passive/1, busy_disconnect_active/1, fill_sendq/1, partial_recv_and_close/1, @@ -53,7 +54,7 @@ active_once_closed/1, send_timeout/1, send_timeout_active/1, otp_7731/1, zombie_sockets/1, otp_7816/1, otp_8102/1, wrapping_oct/0, wrapping_oct/1, otp_9389/1, otp_13939/1, - otp_12242/1, delay_send_error/1]). + otp_12242/1, delay_send_error/1, bidirectional_traffic/1]). %% Internal exports. -export([sender/3, not_owner/1, passive_sockets_server/2, priority_server/1, @@ -80,7 +81,8 @@ all() -> show_econnreset_passive, econnreset_after_sync_send, econnreset_after_async_send_active, econnreset_after_async_send_active_once, - econnreset_after_async_send_passive, linger_zero, + econnreset_after_async_send_passive, + linger_zero, linger_zero_sndbuf, default_options, http_bad_packet, busy_send, busy_disconnect_passive, busy_disconnect_active, fill_sendq, partial_recv_and_close, @@ -97,7 +99,7 @@ all() -> active_once_closed, send_timeout, send_timeout_active, otp_7731, wrapping_oct, zombie_sockets, otp_7816, otp_8102, otp_9389, - otp_12242, delay_send_error]. + otp_12242, delay_send_error, bidirectional_traffic]. groups() -> []. @@ -1356,7 +1358,42 @@ linger_zero(Config) when is_list(Config) -> ok = gen_tcp:close(Client), ok = ct:sleep(1), undefined = erlang:port_info(Client, connected), - {error, econnreset} = gen_tcp:recv(S, PayloadSize). + {error, econnreset} = gen_tcp:recv(S, PayloadSize), + ok. + + +linger_zero_sndbuf(Config) when is_list(Config) -> + %% All the econnreset tests will prove that {linger, {true, 0}} aborts + %% a connection when the driver queue is empty. We will test here + %% that it also works when the driver queue is not empty + %% and the linger zero option is set on the listen socket. + {OS, _} = os:type(), + {ok, Listen} = + gen_tcp:listen(0, [{active, false}, + {recbuf, 4096}, + {show_econnreset, true}, + {linger, {true, 0}}]), + {ok, Port} = inet:port(Listen), + {ok, Client} = + gen_tcp:connect(localhost, Port, + [{active, false}, + {sndbuf, 4096}]), + {ok, Server} = gen_tcp:accept(Listen), + ok = gen_tcp:close(Listen), + PayloadSize = 1024 * 1024, + Payload = binary:copy(<<"0123456789ABCDEF">>, 256 * 1024), % 1 MB + ok = gen_tcp:send(Server, Payload), + case erlang:port_info(Server, queue_size) of + {queue_size, N} when N > 0 -> ok; + {queue_size, 0} when OS =:= win32 -> ok; + {queue_size, 0} = T -> ct:fail(T) + end, + {ok, [{linger, {true, 0}}]} = inet:getopts(Server, [linger]), + ok = gen_tcp:close(Server), + ok = ct:sleep(1), + undefined = erlang:port_info(Server, connected), + {error, closed} = gen_tcp:recv(Client, PayloadSize), + ok. %% Thanks to Luke Gorrie. Tests for a very specific problem with @@ -1984,7 +2021,7 @@ recvtclass(_Config) -> recvtos_ok({unix,openbsd}, OSVer) -> not semver_lt(OSVer, {6,4,0}); recvtos_ok({unix,darwin}, OSVer) -> not semver_lt(OSVer, {19,0,0}); %% Using the option returns einval, so it is not implemented. -recvtos_ok({unix,freebsd}, OSVer) -> not semver_lt(OSVer, {11,2,0}); +recvtos_ok({unix,freebsd}, OSVer) -> not semver_lt(OSVer, {12,1,0}); recvtos_ok({unix,sunos}, OSVer) -> not semver_lt(OSVer, {5,12,0}); %% Does not return any value - not implemented for pktoptions recvtos_ok({unix,linux}, OSVer) -> not semver_lt(OSVer, {3,1,0}); @@ -1996,7 +2033,7 @@ recvtos_ok(_, _) -> false. recvttl_ok({unix,openbsd}, OSVer) -> not semver_lt(OSVer, {6,4,0}); recvttl_ok({unix,darwin}, OSVer) -> not semver_lt(OSVer, {19,0,0}); %% Using the option returns einval, so it is not implemented. -recvttl_ok({unix,freebsd}, OSVer) -> not semver_lt(OSVer, {11,2,0}); +recvttl_ok({unix,freebsd}, OSVer) -> not semver_lt(OSVer, {12,1,0}); recvttl_ok({unix,sunos}, OSVer) -> not semver_lt(OSVer, {5,12,0}); %% Does not return any value - not implemented for pktoptions recvttl_ok({unix,linux}, OSVer) -> not semver_lt(OSVer, {2,7,0}); @@ -2009,7 +2046,7 @@ recvtclass_ok({unix,openbsd}, OSVer) -> not semver_lt(OSVer, {6,4,0}); recvtclass_ok({unix,darwin}, OSVer) -> not semver_lt(OSVer, {19,0,0}); recvtclass_ok({unix,sunos}, OSVer) -> not semver_lt(OSVer, {5,12,0}); %% Using the option returns einval, so it is not implemented. -recvtclass_ok({unix,freebsd}, OSVer) -> not semver_lt(OSVer, {11,2,0}); +recvtclass_ok({unix,freebsd}, OSVer) -> not semver_lt(OSVer, {12,1,0}); %% Does not return any value - not implemented for pktoptions recvtclass_ok({unix,linux}, OSVer) -> not semver_lt(OSVer, {3,1,0}); %% @@ -3456,3 +3493,66 @@ delay_send_error(Config) -> %% This used to result in a double free {error, closed} = gen_tcp:send(S, "hello"). + +-define(ACTIVE_N, 20). + +%% 30-second test for gen_tcp in {active, N} mode, ensuring it does not get stuck. +%% Verifies that erl_check_io properly handles extra EPOLLIN signals. +bidirectional_traffic(Config) when is_list(Config) -> + Workers = erlang:system_info(schedulers_online) * 2, + Payload = crypto:strong_rand_bytes(32), + {ok, LSock} = gen_tcp:listen(0, [binary, {packet, 0}, {active, false}, {reuseaddr, true}]), + %% get all sockets to know failing ends + {ok, Port} = inet:port(LSock), + Control = self(), + Receivers = [spawn_link(fun () -> exchange(LSock, Port, Payload, Control) end) || _ <- lists:seq(1, Workers)], + Result = + receive + {timeout, Socket, Total} -> + {fail, {timeout, Socket, Total}}; + {error, Socket, Reason} -> + {fail, {error, Socket, Reason}} + after 30000 -> + %% if it does not fail in 30 seconds, it most likely works + ok + end, + [begin unlink(Rec), exit(Rec, kill) end || Rec <- Receivers], + Result. + +exchange(LSock, Port, Payload, Control) -> + %% spin up client + _ClntRcv = spawn( + fun () -> + {ok, Client} = gen_tcp:connect("localhost", Port, [binary, {packet, 0}, {active, ?ACTIVE_N}]), + send_recv_loop(Client, Payload, Control) + end), + {ok, Socket} = gen_tcp:accept(LSock), + %% sending process + send_recv_loop(Socket, Payload, Control). + +send_recv_loop(Socket, Payload, Control) -> + %% {active, N} must be set to active > 12 to trigger the issue + %% {active, 30} seems to trigger it quite often & reliably + inet:setopts(Socket, [{active, ?ACTIVE_N}]), + _Snd = spawn_link( + fun Sender() -> + _ = gen_tcp:send(Socket, Payload), + Sender() + end), + recv(Socket, 0, Control). + +recv(Socket, Total, Control) -> + receive + {tcp, Socket, Data} -> + recv(Socket, Total + byte_size(Data), Control); + {tcp_passive, Socket} -> + inet:setopts(Socket, [{active, ?ACTIVE_N}]), + recv(Socket, Total, Control); + {tcp_closed, Socket} -> + exit(terminate); + Other-> + Control ! {error, Socket, Other} + after 2000 -> + %% no data received in 2 seconds, test failed + Control ! {timeout, Socket, Total} + end. diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl index af9985de45..730886865c 100644 --- a/lib/kernel/test/gen_udp_SUITE.erl +++ b/lib/kernel/test/gen_udp_SUITE.erl @@ -37,6 +37,7 @@ buffer_size/1, binary_passive_recv/1, max_buffer_size/1, bad_address/1, read_packets/1, open_fd/1, connect/1, implicit_inet6/1, recvtos/1, recvtosttl/1, recvttl/1, recvtclass/1, + sendtos/1, sendtosttl/1, sendttl/1, sendtclass/1, local_basic/1, local_unbound/1, local_fdopen/1, local_fdopen_unbound/1, local_abstract/1]). @@ -49,6 +50,7 @@ all() -> bad_address, read_packets, open_fd, connect, implicit_inet6, active_n, recvtos, recvtosttl, recvttl, recvtclass, + sendtos, sendtosttl, sendttl, sendtclass, {group, local}]. groups() -> @@ -312,7 +314,6 @@ read_packets(Config) when is_list(Config) -> {ok,R} = gen_udp:open(0, [{read_packets,N1}]), {ok,RP} = inet:port(R), {ok,Node} = start_node(gen_udp_SUITE_read_packets), - Die = make_ref(), %% {V1, Trace1} = read_packets_test(R, RP, Msgs, Node), {ok,[{read_packets,N1}]} = inet:getopts(R, [read_packets]), @@ -324,7 +325,7 @@ read_packets(Config) when is_list(Config) -> stop_node(Node), ct:log("N1=~p, V1=~p vs N2=~p, V2=~p",[N1,V1,N2,V2]), - dump_terms(Config, "trace1.terms", Trace2), + dump_terms(Config, "trace1.terms", Trace1), dump_terms(Config, "trace2.terms", Trace2), %% Because of the inherit racy-ness of the feature it is @@ -348,15 +349,6 @@ dump_terms(Config, Name, Terms) -> file:write_file(FName, term_to_binary(Terms)), ct:log("Logged terms to ~s",[FName]). -infinite_loop(Die) -> - receive - Die -> - ok - after - 0 -> - infinite_loop(Die) - end. - read_packets_test(R, RP, Msgs, Node) -> Receiver = self(), Tracer = @@ -577,19 +569,19 @@ active_n(Config) when is_list(Config) -> recvtos(_Config) -> test_recv_opts( - inet, [{recvtos,tos,96}], + inet, [{recvtos,tos,96}], false, fun recvtos_ok/2). recvtosttl(_Config) -> test_recv_opts( - inet, [{recvtos,tos,96},{recvttl,ttl,33}], + inet, [{recvtos,tos,96},{recvttl,ttl,33}], false, fun (OSType, OSVer) -> recvtos_ok(OSType, OSVer) andalso recvttl_ok(OSType, OSVer) end). recvttl(_Config) -> test_recv_opts( - inet, [{recvttl,ttl,33}], + inet, [{recvttl,ttl,33}], false, fun recvttl_ok/2). recvtclass(_Config) -> @@ -601,15 +593,48 @@ recvtclass(_Config) -> of [_] -> test_recv_opts( - inet6, [{recvtclass,tclass,224}], + inet6, [{recvtclass,tclass,224}], false, fun recvtclass_ok/2); [] -> {skip,ipv6_not_supported,IFs} end. + +sendtos(_Config) -> + test_recv_opts( + inet, [{recvtos,tos,96}], true, + fun sendtos_ok/2). + +sendtosttl(_Config) -> + test_recv_opts( + inet, [{recvtos,tos,96},{recvttl,ttl,33}], true, + fun (OSType, OSVer) -> + sendtos_ok(OSType, OSVer) andalso sendttl_ok(OSType, OSVer) + end). + +sendttl(_Config) -> + test_recv_opts( + inet, [{recvttl,ttl,33}], true, + fun sendttl_ok/2). + +sendtclass(_Config) -> + {ok,IFs} = inet:getifaddrs(), + case + [Name || + {Name,Opts} <- IFs, + lists:member({addr,{0,0,0,0,0,0,0,1}}, Opts)] + of + [_] -> + test_recv_opts( + inet6, [{recvtclass,tclass,224}], true, + fun sendtclass_ok/2); + [] -> + {skip,ipv6_not_supported,IFs} + end. + %% These version numbers are just above the highest noted in daily tests %% where the test fails for a plausible reason, that is the lowest -%% where we can expect that the test mighe succeed, so +%% where we can expect that the test might succeed, so %% skip on platforms lower than this. %% %% On newer versions it might be fixed, but we'll see about that @@ -628,16 +653,55 @@ recvtos_ok({unix,sunos}, OSVer) -> not semver_lt(OSVer, {5,12,0}); recvtos_ok({unix,_}, _) -> true; recvtos_ok(_, _) -> false. +%% Option has no effect +recvttl_ok({unix,sunos}, OSVer) -> not semver_lt(OSVer, {5,12,0}); +%% recvttl_ok({unix,_}, _) -> true; recvttl_ok(_, _) -> false. %% Using the option returns einval, so it is not implemented. recvtclass_ok({unix,darwin}, OSVer) -> not semver_lt(OSVer, {9,9,0}); recvtclass_ok({unix,linux}, OSVer) -> not semver_lt(OSVer, {2,6,11}); +%% Option has no effect +recvtclass_ok({unix,sunos}, OSVer) -> not semver_lt(OSVer, {5,12,0}); %% recvtclass_ok({unix,_}, _) -> true; recvtclass_ok(_, _) -> false. + +%% To send ancillary data seems to require much higher version numbers +%% than receiving it... +%% + +%% Using the option returns einval, so it is not implemented. +sendtos_ok({unix,darwin}, OSVer) -> not semver_lt(OSVer, {19,0,0}); +sendtos_ok({unix,openbsd}, OSVer) -> not semver_lt(OSVer, {6,5,0}); +sendtos_ok({unix,sunos}, OSVer) -> not semver_lt(OSVer, {5,12,0}); +sendtos_ok({unix,linux}, OSVer) -> not semver_lt(OSVer, {4,0,0}); +sendtos_ok({unix,freebsd}, OSVer) -> not semver_lt(OSVer, {12,1,0}); +%% +sendtos_ok({unix,_}, _) -> true; +sendtos_ok(_, _) -> false. + +%% Using the option returns einval, so it is not implemented. +sendttl_ok({unix,darwin}, OSVer) -> not semver_lt(OSVer, {19,0,0}); +sendttl_ok({unix,linux}, OSVer) -> not semver_lt(OSVer, {4,0,0}); +%% Using the option returns enoprotoopt, so it is not implemented. +sendttl_ok({unix,freebsd}, OSVer) -> not semver_lt(OSVer, {12,1,0}); +%% Option has no effect +sendttl_ok({unix,openbsd}, OSVer) -> not semver_lt(OSVer, {6,5,0}); +%% +sendttl_ok({unix,_}, _) -> true; +sendttl_ok(_, _) -> false. + +%% Using the option returns einval, so it is not implemented. +sendtclass_ok({unix,darwin}, OSVer) -> not semver_lt(OSVer, {9,9,0}); +sendtclass_ok({unix,linux}, OSVer) -> not semver_lt(OSVer, {2,6,11}); +%% +sendtclass_ok({unix,_}, _) -> true; +sendtclass_ok(_, _) -> false. + + semver_lt({X1,Y1,Z1}, {X2,Y2,Z2}) -> if X1 > X2 -> false; @@ -650,18 +714,18 @@ semver_lt({X1,Y1,Z1}, {X2,Y2,Z2}) -> end; semver_lt(_, {_,_,_}) -> false. -test_recv_opts(Family, Spec, OSFilter) -> +test_recv_opts(Family, Spec, TestSend, OSFilter) -> OSType = os:type(), OSVer = os:version(), case OSFilter(OSType, OSVer) of true -> io:format("Os: ~p, ~p~n", [OSType,OSVer]), - test_recv_opts(Family, Spec, OSType, OSVer); + test_recv_opts(Family, Spec, TestSend, OSType, OSVer); false -> {skip,{not_supported_for_os_version,{OSType,OSVer}}} end. %% -test_recv_opts(Family, Spec, _OSType, _OSVer) -> +test_recv_opts(Family, Spec, TestSend, _OSType, _OSVer) -> Timeout = 5000, RecvOpts = [RecvOpt || {RecvOpt,_,_} <- Spec], TrueRecvOpts = [{RecvOpt,true} || {RecvOpt,_,_} <- Spec], @@ -686,16 +750,33 @@ test_recv_opts(Family, Spec, _OSType, _OSVer) -> ok = inet:setopts(S1, TrueRecvOpts_OptsVals), {ok,TrueRecvOpts_OptsVals} = inet:getopts(S1, RecvOpts ++ Opts), %% + %% S1 now has true receive options and set option values + %% {ok,S2} = gen_udp:open(0, [Family,binary,{active,true}|FalseRecvOpts]), {ok,P2} = inet:port(S2), {ok,FalseRecvOpts_OptsVals2} = inet:getopts(S2, RecvOpts ++ Opts), OptsVals2 = FalseRecvOpts_OptsVals2 -- FalseRecvOpts, %% - ok = gen_udp:send(S2, Addr, P1, <<"abcde">>), + %% S2 now has false receive options and default option values, + %% OptsVals2 contains the default option values + %% + ok = gen_udp:send(S2, {Addr,P1}, <<"abcde">>), ok = gen_udp:send(S1, Addr, P2, <<"fghij">>), + TestSend andalso + begin + ok = gen_udp:send(S2, Addr, P1, OptsVals, <<"ABCDE">>), + ok = gen_udp:send(S2, {Addr,P1}, OptsVals, <<"12345">>) + end, {ok,{_,P2,OptsVals3,<<"abcde">>}} = gen_udp:recv(S1, 0, Timeout), verify_sets_eq(OptsVals3, OptsVals2), + TestSend andalso + begin + {ok,{_,P2,OptsVals0,<<"ABCDE">>}} = gen_udp:recv(S1, 0, Timeout), + {ok,{_,P2,OptsVals1,<<"12345">>}} = gen_udp:recv(S1, 0, Timeout), + verify_sets_eq(OptsVals0, OptsVals), + verify_sets_eq(OptsVals1, OptsVals) + end, receive {udp,S2,_,P1,<<"fghij">>} -> ok; @@ -710,8 +791,16 @@ test_recv_opts(Family, Spec, _OSType, _OSVer) -> ok = inet:setopts(S2, TrueRecvOpts), {ok,TrueRecvOpts} = inet:getopts(S2, RecvOpts), %% - ok = gen_udp:send(S2, Addr, P1, <<"klmno">>), - ok = gen_udp:send(S1, Addr, P2, <<"pqrst">>), + %% S1 now has false receive options and set option values + %% + %% S2 now has true receive options and default option values + %% + ok = gen_udp:send(S2, {Addr,P1}, [], <<"klmno">>), + ok = gen_udp:send(S1, {Family,{loopback,P2}}, <<"pqrst">>), + TestSend andalso + begin + ok = gen_udp:send(S1, {Family,{loopback,P2}}, OptsVals2, <<"PQRST">>) + end, {ok,{_,P2,<<"klmno">>}} = gen_udp:recv(S1, 0, Timeout), receive {udp,S2,_,P1,OptsVals4,<<"pqrst">>} -> @@ -721,9 +810,18 @@ test_recv_opts(Family, Spec, _OSType, _OSVer) -> after Timeout -> exit(timeout) end, + TestSend andalso + receive + {udp,S2,_,P1,OptsVals5,<<"PQRST">>} -> + verify_sets_eq(OptsVals5, OptsVals2); + Other3 -> + exit({unexpected,Other3}) + after Timeout -> + exit(timeout) + end, ok = gen_udp:close(S1), ok = gen_udp:close(S2), -%% exit({{OSType,OSVer},success}), % In search for the truth +%%% exit({{_OSType,_OSVer},success}), % In search for the truth ok. verify_sets_eq(L1, L2) -> @@ -877,6 +975,10 @@ connect(Config) when is_list(Config) -> implicit_inet6(Config) when is_list(Config) -> Host = ok(inet:gethostname()), case inet:getaddr(Host, inet6) of + {ok,{16#fe80,0,0,0,_,_,_,_} = Addr} -> + {skip, + "Got link local IPv6 address: " + ++inet:ntoa(Addr)}; {ok,Addr} -> implicit_inet6(Host, Addr); {error,Reason} -> @@ -927,11 +1029,12 @@ ok({ok,V}) -> V; ok(NotOk) -> try throw(not_ok) catch - throw:Thrown:Stacktrace -> - erlang:raise( - error, {Thrown, NotOk}, tl(Stacktrace)) + throw:not_ok:Stacktrace -> + raise_error({not_ok, NotOk}, tl(Stacktrace)) end. +raise_error(Reason, Stacktrace) -> + erlang:raise(error, Reason, Stacktrace). local_filename(Tag) -> "/tmp/" ?MODULE_STRING "_" ++ os:getpid() ++ "_" ++ atom_to_list(Tag). diff --git a/lib/kernel/test/os_SUITE_data/my_fds.c b/lib/kernel/test/os_SUITE_data/my_fds.c index 704a4d1e1d..8b1ce13822 100644 --- a/lib/kernel/test/os_SUITE_data/my_fds.c +++ b/lib/kernel/test/os_SUITE_data/my_fds.c @@ -1,5 +1,9 @@ #include <stdio.h> +#ifdef HAVE_UNISTD_H +# include <unistd.h> +#endif + int main(int argc, char** argv) { diff --git a/lib/kernel/test/sendfile_SUITE.erl b/lib/kernel/test/sendfile_SUITE.erl index ad060aa05c..5d1b89fef9 100644 --- a/lib/kernel/test/sendfile_SUITE.erl +++ b/lib/kernel/test/sendfile_SUITE.erl @@ -23,7 +23,7 @@ -include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). --export([all/0, init_per_suite/1, end_per_suite/1, init_per_testcase/2]). +-export([all/0, init_per_suite/1, end_per_suite/1, init_per_testcase/2, end_per_testcase/2]). -export([sendfile_server/2, sendfile_do_recv/2, init/1, handle_event/2]). @@ -107,7 +107,27 @@ init_per_testcase(TC,Config) when TC == t_sendfile_recvduring; {skip,"Not supported"} end; init_per_testcase(_TC,Config) -> - Config. + case read_fd_info() of + {ok, NumFDs, FDDetails} -> + [{fds,NumFDs},{details,FDDetails}|Config]; + {error,_Reason} -> + Config + end. + +end_per_testcase(_TC,Config) -> + case proplists:get_value(fds, Config) of + undefined -> + ok; + NumOldFDs -> + case read_fd_info() of + {ok, NumFDs, FDDetails} when NumFDs =/= NumOldFDs -> + ct:log("FDs: ~n~ts~nOldFDs: ~n~ts~n", + [FDDetails,proplists:get_value(details,Config)]), + {fail,"Too many (or too few) fds open"}; + _ -> + ok + end + end. t_sendfile_small(Config) when is_list(Config) -> Filename = proplists:get_value(small_file, Config), @@ -171,7 +191,8 @@ t_sendfile_big_size(Config) -> {ok, #file_info{size = Size}} = file:read_file_info(Filename), {ok,D} = file:open(Filename,[read|FileOpts]), - {ok, Size} = file:sendfile(D, Sock,0,Size,SendfileOpts), + {ok,Size} = file:sendfile(D,Sock,0,Size,SendfileOpts), + ok = file:close(D), Size end, @@ -507,6 +528,18 @@ sendfile(Filename,Sock,Opts) -> Res end. +%% This function returns the number of open fds on a system +%% and also a string representing more detailed information +%% for debugging. +%% It only supports linux for now. +read_fd_info() -> + ProcFd = "/proc/" ++ os:getpid() ++ "/fd", + case file:list_dir(ProcFd) of + {ok, FDs} -> + {ok, length(FDs), os:cmd("ls -l " ++ ProcFd)}; + Error -> + Error + end. %% Error handler diff --git a/lib/kernel/test/seq_trace_SUITE.erl b/lib/kernel/test/seq_trace_SUITE.erl index ee8f4e94f8..07a46ac51e 100644 --- a/lib/kernel/test/seq_trace_SUITE.erl +++ b/lib/kernel/test/seq_trace_SUITE.erl @@ -23,6 +23,7 @@ init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2]). -export([token_set_get/1, tracer_set_get/1, print/1, + old_heap_token/1, send/1, distributed_send/1, recv/1, distributed_recv/1, trace_exit/1, distributed_exit/1, call/1, port/1, match_set_seq_token/1, gc_seq_token/1, label_capability_mismatch/1, @@ -47,6 +48,7 @@ suite() -> all() -> [token_set_get, tracer_set_get, print, send, send_literal, distributed_send, recv, distributed_recv, trace_exit, + old_heap_token, distributed_exit, call, port, match_set_seq_token, gc_seq_token, label_capability_mismatch]. @@ -146,17 +148,19 @@ tracer_set_get(Config) when is_list(Config) -> ok. print(Config) when is_list(Config) -> - lists:foreach(fun do_print/1, ?TIMESTAMP_MODES). + [do_print(TsType, Label) || TsType <- ?TIMESTAMP_MODES, + Label <- [17, "label"]]. -do_print(TsType) -> +do_print(TsType, Label) -> start_tracer(), + seq_trace:set_token(label, Label), set_token_flags([print, TsType]), - seq_trace:print(0,print1), + seq_trace:print(Label,print1), seq_trace:print(1,print2), seq_trace:print(print3), seq_trace:reset_trace(), - [{0,{print,_,_,[],print1}, Ts0}, - {0,{print,_,_,[],print3}, Ts1}] = stop_tracer(2), + [{Label,{print,_,_,[],print1}, Ts0}, + {Label,{print,_,_,[],print3}, Ts1}] = stop_tracer(2), check_ts(TsType, Ts0), check_ts(TsType, Ts1). @@ -560,6 +564,24 @@ get_port_message(Port) -> end. +%% OTP-15849 ERL-700 +%% Verify changing label on existing token when it resides on old heap. +%% Bug caused faulty ref from old to new heap. +old_heap_token(Config) when is_list(Config) -> + seq_trace:set_token(label, 1), + erlang:garbage_collect(self(), [{type, minor}]), + erlang:garbage_collect(self(), [{type, minor}]), + %% Now token tuple should be on old-heap. + %% Set a new non-literal label which should reside on new-heap. + NewLabel = {self(), "new label"}, + 1 = seq_trace:set_token(label, NewLabel), + + %% If bug, we now have a ref from old to new heap. Yet another minor gc + %% will make that a ref to deallocated memory. + erlang:garbage_collect(self(), [{type, minor}]), + {label,NewLabel} = seq_trace:get_token(label), + ok. + match_set_seq_token(doc) -> ["Tests that match spec function set_seq_token does not " diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk index b1ae513223..1dd234e72b 100644 --- a/lib/kernel/vsn.mk +++ b/lib/kernel/vsn.mk @@ -1 +1 @@ -KERNEL_VSN = 6.3.1 +KERNEL_VSN = 6.3.1.3 diff --git a/lib/odbc/test/README b/lib/odbc/test/README index 0a8495afbb..5ae6073d9a 100644 --- a/lib/odbc/test/README +++ b/lib/odbc/test/README @@ -47,7 +47,7 @@ something like this: --- Start example of .odbc.ini ---- -[Postgres] +[PostgresLinux64Ubuntu] Driver=/usr/lib/psqlodbc.so Description=Postgres driver ServerName=myhost diff --git a/lib/odbc/test/postgres.erl b/lib/odbc/test/postgres.erl index 1955358206..e055be9544 100644 --- a/lib/odbc/test/postgres.erl +++ b/lib/odbc/test/postgres.erl @@ -207,7 +207,7 @@ bit_true_selected() -> %------------------------------------------------------------------------- float_min() -> - 1.79e-307. + 5.0e-324. float_max() -> 1.79e+308. @@ -215,7 +215,7 @@ create_float_table() -> " (FIELD float)". float_underflow() -> - "1.80e-308". + "2.4e-324". float_overflow() -> "1.80e+308". @@ -288,7 +288,7 @@ describe_string() -> {"str4",{sql_varchar,10}}]}. describe_floating() -> - {ok,[{"f",sql_real},{"r",sql_real},{"d",{sql_float,15}}]}. + {ok,[{"f",sql_real},{"r",sql_real},{"d",{sql_float,17}}]}. describe_dec_num() -> {ok,[{"mydec",{sql_numeric,9,3}},{"mynum",{sql_numeric,9,2}}]}. diff --git a/lib/public_key/asn1/CMSAesRsaesOaep.asn1 b/lib/public_key/asn1/CMSAesRsaesOaep.asn1 new file mode 100644 index 0000000000..ca8c7b7f92 --- /dev/null +++ b/lib/public_key/asn1/CMSAesRsaesOaep.asn1 @@ -0,0 +1,39 @@ +CMSAesRsaesOaep {iso(1) member-body(2) us(840) rsadsi(113549) + pkcs(1) pkcs-9(9) smime(16) modules(0) id-mod-cms-aes(19) } + + +DEFINITIONS IMPLICIT TAGS ::= +BEGIN + +-- EXPORTS ALL -- +IMPORTS + -- PKIX + AlgorithmIdentifier + FROM PKIX1Explicit88 {iso(1) identified-organization(3) dod(6) + internet(1) security(5) mechanisms(5) pkix(7) id-mod(0) + id-pkix1-explicit(18)}; + +-- AES information object identifiers -- + +aes OBJECT IDENTIFIER ::= { joint-iso-itu-t(2) country(16) us(840) + organization(1) gov(101) csor(3) nistAlgorithms(4) 1 } + +-- AES using CBC-chaining mode for key sizes of 128, 192, 256 + +id-aes128-CBC OBJECT IDENTIFIER ::= { aes 2 } +id-aes192-CBC OBJECT IDENTIFIER ::= { aes 22 } +id-aes256-CBC OBJECT IDENTIFIER ::= { aes 42 } + +-- AES-IV is a the parameter for all the above object identifiers. + +AES-IV ::= OCTET STRING (SIZE(16)) + + +-- AES Key Wrap Algorithm Identifiers - Parameter is absent + +id-aes128-wrap OBJECT IDENTIFIER ::= { aes 5 } +id-aes192-wrap OBJECT IDENTIFIER ::= { aes 25 } +id-aes256-wrap OBJECT IDENTIFIER ::= { aes 45 } + + +END diff --git a/lib/public_key/asn1/Makefile b/lib/public_key/asn1/Makefile index a920ea87ea..10952106c6 100644 --- a/lib/public_key/asn1/Makefile +++ b/lib/public_key/asn1/Makefile @@ -42,7 +42,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/public_key-$(VSN) ASN_TOP = OTP-PUB-KEY PKCS-FRAME ASN_MODULES = PKIX1Explicit88 PKIX1Implicit88 PKIX1Algorithms88 \ PKIXAttributeCertificate PKCS-1 PKCS-3 PKCS-7 PKCS-8 PKCS-10 PKCS5v2-0 OTP-PKIX \ - InformationFramework RFC5639 + InformationFramework RFC5639 CMSAesRsaesOaep ASN_ASNS = $(ASN_MODULES:%=%.asn1) ASN_ERLS = $(ASN_TOP:%=%.erl) ASN_HRLS = $(ASN_TOP:%=%.hrl) diff --git a/lib/public_key/asn1/OTP-PUB-KEY.set.asn b/lib/public_key/asn1/OTP-PUB-KEY.set.asn index b3f3ccdb77..7ab1684ff3 100644 --- a/lib/public_key/asn1/OTP-PUB-KEY.set.asn +++ b/lib/public_key/asn1/OTP-PUB-KEY.set.asn @@ -10,3 +10,5 @@ ECPrivateKey.asn1 PKCS-7.asn1 PKCS-10.asn1 RFC5639.asn1 +CMSAesRsaesOaep.asn1 + diff --git a/lib/public_key/doc/src/notes.xml b/lib/public_key/doc/src/notes.xml index d83dd24f41..834cebb507 100644 --- a/lib/public_key/doc/src/notes.xml +++ b/lib/public_key/doc/src/notes.xml @@ -35,6 +35,21 @@ <file>notes.xml</file> </header> +<section><title>Public_Key 1.6.6.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Support Pasword based encryption with AES</p> + <p> + Own Id: OTP-15870 Aux Id: ERL-952 </p> + </item> + </list> + </section> + +</section> + <section><title>Public_Key 1.6.6</title> <section><title>Improvements and New Features</title> diff --git a/lib/public_key/doc/src/public_key_app.xml b/lib/public_key/doc/src/public_key_app.xml index 923a9f1dfb..5f2c50711a 100644 --- a/lib/public_key/doc/src/public_key_app.xml +++ b/lib/public_key/doc/src/public_key_app.xml @@ -51,6 +51,9 @@ Diffie-Hellman Key Agreement Standard </item> <item>Supports <url href="http://www.ietf.org/rfc/rfc2898.txt"> PKCS-5</url> - Password-Based Cryptography Standard </item> + <item>Supports <url href="http://www.ietf.org/rfc/fc3565.txt"> AES </url> - + Use of the Advanced Encryption Standard (AES) Algorithm in Cryptographic Message Syntax (CMS) + </item> <item>Supports <url href="http://www.ietf.org/rfc/rfc5208.txt"> PKCS-8</url> - Private-Key Information Syntax Standard</item> <item>Supports <url href="http://www.ietf.org/rfc/rfc5967.txt"> PKCS-10</url> - diff --git a/lib/public_key/src/pubkey_pbe.erl b/lib/public_key/src/pubkey_pbe.erl index 806f7c5b0f..b9fe219dcf 100644 --- a/lib/public_key/src/pubkey_pbe.erl +++ b/lib/public_key/src/pubkey_pbe.erl @@ -26,9 +26,7 @@ -export([encode/4, decode/4, decrypt_parameters/1, encrypt_parameters/1]). -export([pbdkdf1/4, pbdkdf2/7]). --define(DEFAULT_SHA_MAC_KEYLEN, 20). -define(ASN1_OCTET_STR_TAG, 4). --define(IV_LEN, 8). %%==================================================================== %% Internal application API @@ -41,16 +39,21 @@ %%-------------------------------------------------------------------- encode(Data, Password, "DES-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:block_encrypt(des_cbc, Key, IV, pbe_pad(Data, KeyDevParams)); - + crypto:block_encrypt(des_cbc, Key, IV, pbe_pad(Data, block_size(des_cbc))); encode(Data, Password, "DES-EDE3-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), <<Key1:8/binary, Key2:8/binary, Key3:8/binary>> = Key, - crypto:block_encrypt(des3_cbc, [Key1, Key2, Key3], IV, pbe_pad(Data)); - + crypto:block_encrypt(des3_cbc, [Key1, Key2, Key3], IV, pbe_pad(Data, block_size(des_3ede))); encode(Data, Password, "RC2-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:block_encrypt(rc2_cbc, Key, IV, pbe_pad(Data, KeyDevParams)). + crypto:block_encrypt(rc2_cbc, Key, IV, pbe_pad(Data, block_size(rc2_cbc))); +encode(Data, Password, "AES-128-CBC" = Cipher, KeyDevParams) -> + {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), + crypto:block_encrypt(aes_cbc128, Key, IV, pbe_pad(Data, block_size(aes_128_cbc))); +encode(Data, Password, "AES-256-CBC"= Cipher, KeyDevParams) -> + {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), + crypto:block_encrypt(aes_cbc256, Key, IV, pbe_pad(Data, block_size(aes_256_cbc))). + %%-------------------------------------------------------------------- -spec decode(binary(), string(), string(), term()) -> binary(). %% @@ -59,21 +62,19 @@ encode(Data, Password, "RC2-CBC" = Cipher, KeyDevParams) -> decode(Data, Password,"DES-CBC"= Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), crypto:block_decrypt(des_cbc, Key, IV, Data); - decode(Data, Password,"DES-EDE3-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), <<Key1:8/binary, Key2:8/binary, Key3:8/binary>> = Key, crypto:block_decrypt(des3_cbc, [Key1, Key2, Key3], IV, Data); - decode(Data, Password,"RC2-CBC"= Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), crypto:block_decrypt(rc2_cbc, Key, IV, Data); - -decode(Data, Password,"AES-128-CBC"= Cipher, IV) -> - %% PKCS5_SALT_LEN is 8 bytes - <<Salt:8/binary,_/binary>> = IV, - {Key, _} = password_to_key_and_iv(Password, Cipher, Salt), - crypto:block_decrypt(aes_cbc128, Key, IV, Data). +decode(Data, Password,"AES-128-CBC"= Cipher, KeyDevParams) -> + {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), + crypto:block_decrypt(aes_cbc128, Key, IV, Data); +decode(Data, Password,"AES-256-CBC"= Cipher, KeyDevParams) -> + {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), + crypto:block_decrypt(aes_cbc256, Key, IV, Data). %%-------------------------------------------------------------------- -spec pbdkdf1(string(), iodata(), integer(), atom()) -> binary(). @@ -131,13 +132,15 @@ password_to_key_and_iv(Password, _Cipher, {#'PBEParameter'{salt = Salt, <<Key:8/binary, IV:8/binary, _/binary>> = pbdkdf1(Password, Salt, Count, Hash), {Key, IV}; -password_to_key_and_iv(Password, Cipher, Salt) -> - KeyLen = derived_key_length(Cipher, undefined), +password_to_key_and_iv(Password, Cipher, KeyDevParams) -> + %% PKCS5_SALT_LEN is 8 bytes + <<Salt:8/binary,_/binary>> = KeyDevParams, + KeyLen = derived_key_length(Cipher, undefined), <<Key:KeyLen/binary, _/binary>> = pem_encrypt(<<>>, Password, Salt, ceiling(KeyLen div 16), <<>>, md5), %% Old PEM encryption does not use standard encryption method - %% pbdkdf1 and uses then salt as IV - {Key, Salt}. + %% pbdkdf1 + {Key, KeyDevParams}. pem_encrypt(_, _, _, 0, Acc, _) -> Acc; pem_encrypt(Prev, Password, Salt, Count, Acc, Hash) -> @@ -150,17 +153,15 @@ do_pbdkdf1(Prev, Count, Acc, Hash) -> Result = crypto:hash(Hash, Prev), do_pbdkdf1(Result, Count-1 , <<Result/binary, Acc/binary>>, Hash). -iv(#'PBES2-params_encryptionScheme'{algorithm = Algo, - parameters = ASN1IV}) - when (Algo == ?'desCBC') or - (Algo == ?'des-EDE3-CBC') -> - <<?ASN1_OCTET_STR_TAG, ?IV_LEN, IV:?IV_LEN/binary>> = decode_handle_open_type_wrapper(ASN1IV), - IV; iv(#'PBES2-params_encryptionScheme'{algorithm = ?'rc2CBC', parameters = ASN1IV}) -> {ok, #'RC2-CBC-Parameter'{iv = IV}} = 'PKCS-FRAME':decode('RC2-CBC-Parameter', decode_handle_open_type_wrapper(ASN1IV)), - iolist_to_binary(IV). + iolist_to_binary(IV); +iv(#'PBES2-params_encryptionScheme'{algorithm = _Algo, + parameters = ASN1IV}) -> + <<?ASN1_OCTET_STR_TAG, Len:8/unsigned-big-integer, IV:Len/binary>> = decode_handle_open_type_wrapper(ASN1IV), + IV. blocks(1, N, Index, Password, Salt, Count, Prf, PrfHash, PrfLen, Acc) -> <<XorSum:N/binary, _/binary>> = xor_sum(Password, Salt, Count, Index, Prf, PrfHash, PrfLen), @@ -217,17 +218,9 @@ pbe1_oid("RC2-CBC", md5) -> pbe1_oid("DES-CBC", md5) -> ?'pbeWithMD5AndDES-CBC'. -pbe_pad(Data, {#'PBEParameter'{}, _}) -> - pbe_pad(Data); -pbe_pad(Data, #'PBES2-params'{}) -> - pbe_pad(Data); -pbe_pad(Data, _) -> -pbe_pad(Data).%% Data. - - -pbe_pad(Data) -> - N = 8 - (erlang:byte_size(Data) rem 8), - Pad = list_to_binary(lists:duplicate(N, N)), +pbe_pad(Data, BlockSize) -> + N = BlockSize - (erlang:byte_size(Data) rem BlockSize), + Pad = binary:copy(<<N>>, N), <<Data/binary, Pad/binary>>. key_derivation_params(#'PBES2-params'{keyDerivationFunc = KeyDerivationFunc, @@ -249,11 +242,27 @@ key_derivation_params(#'PBES2-params'{keyDerivationFunc = KeyDerivationFunc, pseudo_random_function(#'PBKDF2-params_prf'{algorithm = {_,_, _,'id-hmacWithSHA1'}}) -> {fun crypto:hmac/4, sha, pseudo_output_length(?'id-hmacWithSHA1')}; -pseudo_random_function(#'PBKDF2-params_prf'{algorithm = ?'id-hmacWithSHA1'}) -> - {fun crypto:hmac/4, sha, pseudo_output_length(?'id-hmacWithSHA1')}. +pseudo_random_function(#'PBKDF2-params_prf'{algorithm = ?'id-hmacWithSHA1' = Algo}) -> + {fun crypto:hmac/4, sha, pseudo_output_length(Algo)}; +pseudo_random_function(#'PBKDF2-params_prf'{algorithm = ?'id-hmacWithSHA224'= Algo}) -> + {fun crypto:hmac/4, sha224, pseudo_output_length(Algo)}; +pseudo_random_function(#'PBKDF2-params_prf'{algorithm = ?'id-hmacWithSHA256' = Algo}) -> + {fun crypto:hmac/4, sha256, pseudo_output_length(Algo)}; +pseudo_random_function(#'PBKDF2-params_prf'{algorithm = ?'id-hmacWithSHA384' = Algo}) -> + {fun crypto:hmac/4, sha384, pseudo_output_length(Algo)}; +pseudo_random_function(#'PBKDF2-params_prf'{algorithm = ?'id-hmacWithSHA512' = Algo}) -> + {fun crypto:hmac/4, sha512, pseudo_output_length(Algo)}. pseudo_output_length(?'id-hmacWithSHA1') -> - ?DEFAULT_SHA_MAC_KEYLEN. + 20; %%160/8 +pseudo_output_length(?'id-hmacWithSHA224') -> + 28; %%%224/8 +pseudo_output_length(?'id-hmacWithSHA256') -> + 32; %%256/8 +pseudo_output_length(?'id-hmacWithSHA384') -> + 48; %%384/8 +pseudo_output_length(?'id-hmacWithSHA512') -> + 64. %%512/8 derived_key_length(_, Len) when is_integer(Len) -> Len; @@ -266,9 +275,33 @@ derived_key_length(Cipher,_) when (Cipher == ?'rc2CBC') or derived_key_length(Cipher,_) when (Cipher == ?'des-EDE3-CBC') or (Cipher == "DES-EDE3-CBC") -> 24; -derived_key_length(Cipher,_) when (Cipher == "AES-128-CBC") -> + +derived_key_length(Cipher,_) when (Cipher == "AES-128-CBC"); + (Cipher == ?'id-aes128-CBC') -> + 16; +derived_key_length(Cipher,_) when (Cipher == "AES-192-CBC"); + (Cipher == ?'id-aes192-CBC') -> + 24; + +derived_key_length(Cipher,_) when (Cipher == "AES-256-CBC"); + (Cipher == ?'id-aes256-CBC') -> + 32. + +block_size(Cipher) when Cipher == rc2_cbc; + Cipher == des_cbc; + Cipher == des_3ede -> + 8; +block_size(Cipher) when Cipher == aes_128_cbc; + Cipher == aes_192_cbc; + Cipher == aes_256_cbc -> 16. +cipher(#'PBES2-params_encryptionScheme'{algorithm = ?'id-aes128-CBC'}) -> + "AES-128-CBC"; +cipher(#'PBES2-params_encryptionScheme'{algorithm = ?'id-aes192-CBC'}) -> + "AES-192-CBC"; +cipher(#'PBES2-params_encryptionScheme'{algorithm = ?'id-aes256-CBC'}) -> + "AES-256-CBC"; cipher(#'PBES2-params_encryptionScheme'{algorithm = ?'desCBC'}) -> "DES-CBC"; cipher(#'PBES2-params_encryptionScheme'{algorithm = ?'des-EDE3-CBC'}) -> diff --git a/lib/public_key/test/pbe_SUITE.erl b/lib/public_key/test/pbe_SUITE.erl index 523c9e2515..5dea35dce6 100644 --- a/lib/public_key/test/pbe_SUITE.erl +++ b/lib/public_key/test/pbe_SUITE.erl @@ -218,7 +218,9 @@ pbes2() -> [{doc,"Tests encode/decode EncryptedPrivateKeyInfo encrypted with different ciphers using PBES2"}]. pbes2(Config) when is_list(Config) -> decode_encode_key_file("pbes2_des_cbc_enc_key.pem", "password", "DES-CBC", Config), - decode_encode_key_file("pbes2_des_ede3_cbc_enc_key.pem", "password", "DES-EDE3-CBC", Config), + decode_encode_key_file("pbes2_des_ede3_cbc_enc_key.pem", "password", "DES-EDE3-CBC", Config), + decode_encode_key_file("pbes2_aes_128_enc_key.pem", "password", "AES-128-CBC", Config), + decode_encode_key_file("pbes2_aes_256_enc_key.pem", "password", "AES-256-CBC", Config), case lists:member(rc2_cbc, proplists:get_value(ciphers, crypto:supports())) of true -> decode_encode_key_file("pbes2_rc2_cbc_enc_key.pem", "password", "RC2-CBC", Config); @@ -231,7 +233,6 @@ decode_encode_key_file(File, Password, Cipher, Config) -> {ok, PemKey} = file:read_file(filename:join(Datadir, File)), PemEntry = public_key:pem_decode(PemKey), - ct:print("Pem entry: ~p" , [PemEntry]), [{Asn1Type, _, {Cipher,_} = CipherInfo} = PubEntry] = PemEntry, #'RSAPrivateKey'{} = KeyInfo = public_key:pem_entry_decode(PubEntry, Password), PemKey1 = public_key:pem_encode([public_key:pem_entry_encode(Asn1Type, KeyInfo, {CipherInfo, Password})]), diff --git a/lib/public_key/test/pbe_SUITE_data/pbes2_aes_128_enc_key.pem b/lib/public_key/test/pbe_SUITE_data/pbes2_aes_128_enc_key.pem new file mode 100644 index 0000000000..5702119ad6 --- /dev/null +++ b/lib/public_key/test/pbe_SUITE_data/pbes2_aes_128_enc_key.pem @@ -0,0 +1,30 @@ +-----BEGIN ENCRYPTED PRIVATE KEY----- +MIIFLTBXBgkqhkiG9w0BBQ0wSjApBgkqhkiG9w0BBQwwHAQIWrPgmqJqNpICAggA +MAwGCCqGSIb3DQIJBQAwHQYJYIZIAWUDBAECBBA/bbIMYqQMUDxMk9ifPR7ABIIE +0Drfqke1/ccFxk786hTh36yjVo48Xx7B3Scb92KtmyQpNaR6GbR+jhP9cxIcvmGN +YroCB896VJSIx8PraqGgIJ1hblZXyfLanB0mUnZvaaQ4xp3UJT53a0yOm5Lfd+fB +0TyaoEzca2jA5EVVh3yH6gzNsvQJRw6cQP5CAptLjiUv2jrwVGnO8x8X4egJDLZS +Sb8B5AW8h1sGsyKEEFto6gpBjVqnVn5veMoI/Cfs9qDr071+dhbps/m6pseKKp0z +8qeFM7+9Y4npD1VYg2gqOFi19QAI3gwq6tC8grOzRA8dPFUgpV9eMToVsI2OFQc1 +xnFZEV7NZVymh5HjKM1jwFy6es+5TFoMtRu6vDxKS6Y13lIlZ4oQSh8aXtG5Ylt2 +CqsKNHyDbZUpvKe/k19TBmVXQBCYFuN733jI9/4JBtpygnxwt1aXCvq/PFFGsTS4 +p1JOQvr/jaD7b4JO6IMXH1kSVxiMXKXNG7wPUNr6OWJvc7OqdclsZa7ibEx4L52x +DuFmsxQo4a3iibhbcjr436OmR5Uw2UAstB5qxWfMhkt+e7rRhCOh/3O7SAYEpt+f +Zr2VFXdGme4kR6uMCzgGiSh0qCseQXpJUZVufn/Go9r+601OJTJIQ9a2VoqlMR8o +Dd14D0gBXXaZkY60Mh8iXR/MjKDuv0KBUyBzfcpk3fLmv0PhGSkbn6j+q1jZbogm +EhI0AL5s2EoofuBdvgdusBhCrrwCMonprqR7BuaKPD0GEw5utnT5ovcUg/sjMJox +10100QwAzQScU4iG/xic/TsN+ZMumhUcYs003MsZkRLvCEFxZurEMx7819CqfhIc +NGd7ETTBSwoNf5pXRTHaTbW6pPiIeWunLUUVsRcNoBtL/cXmg+mu1zdsD7nD51mJ +vG9A7LPW7XVl2Jv2NgQoKkHYO7cVozmcz6AE2z1q+XN4LGto8JEZktb6E7UIyXXg +Ls4Tv0sn5TLgtaJ31w4+9iybNiGoVYOc4h0s5DoNR4ivcZ6n/Qnf8PTrNzejEJY6 +R/UnDbc24u0palGc1kei99d0BYodnq4OlAj7M7ML0GncftInhgA0Dp81YG5PujMa +irhvwtnD5Xysfh1YrroAEN7Qxc8+2JlpgNSFlFFkMgfibc6jvTX6/C6MaFz8hiOq +W43ZBEzjMIs23ZrJKOJGsuTdHSob+VbvqIMgS2PeGb/6g3/GjdipCbynNhX3zUOM +3j/lpZOiAwE/Bftr5FOSfTFpnyorIIeyWgROEZTTL4eSYvnBjzf+tUdXY7ltxJie +q0rpQ42X7+B4gTo8Qj/xC7LXSCldERK57cCwwITvjcHwxPyOiJ9BMI1HlRQ/Fo3C +lPYIst1xjJ67qrTm6mWkor2hUOZcg4MOOzXWuijWRGJ/Wz0H+GKWtoE2X536D6sy +a4Nwwj09oFY4Fph/SUNwy0MLpTSzikpUx6mxjbs3Odvo6tWWVcicp/dCWYCqLpGU +3axEb/qlsaRNtKJg9O3Fq7hh1BTyLNGB2ET5wSKtlSD0bDeF15bBvkHB3z2/lDls +YQ2hEHMjeSEZZyGTPqEHwtBuUwiWBBXwOIhT8nfYXbHWR0CLBLth2+E/JCaO9hD2 +V277arqNFa8nugZMwS+ragi6vbgIX4BiS/rnfYXgqaxD +-----END ENCRYPTED PRIVATE KEY----- diff --git a/lib/public_key/test/pbe_SUITE_data/pbes2_aes_192_enc_key.pem b/lib/public_key/test/pbe_SUITE_data/pbes2_aes_192_enc_key.pem new file mode 100644 index 0000000000..ee82e9f667 --- /dev/null +++ b/lib/public_key/test/pbe_SUITE_data/pbes2_aes_192_enc_key.pem @@ -0,0 +1,30 @@ +-----BEGIN ENCRYPTED PRIVATE KEY----- +MIIFLTBXBgkqhkiG9w0BBQ0wSjApBgkqhkiG9w0BBQwwHAQIcqBCM7v+ZlkCAggA +MAwGCCqGSIb3DQIJBQAwHQYJYIZIAWUDBAEWBBD93r4IWBhvry+cdfwIDOKeBIIE +0DXM8S70sMsUmwxRZQtKwGfYddEWIc9lrEdsgEEuonF6NrseRq7QdXnBSPwq5f0O +ofMZ/0OCun3Qg1ls1EdsyKdijSOq27ZhHCnmWi1Rw1ApJIAq5i/jY8U17+lUakvG +VtcsuRzlKmFxbBW44kLK7vK6xiA76HPx0I4ZXcdywR0pbLT1ubbhbQ9djLnBiYkT +odszGTyxNceEse1Hu/RhFK17tnwov0fdioKY2i9F7qfq8lYLPrusEKTY7tOVjFOh +bXeCry1BL0KTt65JVGR9xQCI0qokEU0QrCgD6skq7Vx2C/Ho1sW6h8FBFVIm6ozO +bEUtVk3Xgs5yieetha1GxJAang1VxAPemnXfOmVapoSgSv1BQyDdnk3067Sfkh64 +A5yf44BUjvJsSd/ViCVmCryoXU7KOMAdFkyRSiDDLQus6bZGEhc6f+VEikG+TZ2L +xxY4OucE2Bz67S6ycyOUpXKo0+FW0juE6NTJdlYSXWOvfciZKA83h6yAej6MfUEu +4orIvnCTVO7i3+hHybnSgftj42jrqqZzeXll8rkGHg4syrKRVaDD6qfJjgAHBJkJ +pZT4zZwuJ1puWfBykI25S4mKUnk0erq4N5jpGqdm7U14fWBWCjZN85jY4WgZZOJx +kBNO2NbmZKzZEzRGyMJ563z4l7MNfzZBHv+FeBNkX146J4ZhMbT8IXPGV9peNWqu +mY2B9RhN4hlDrd3Hfz5uiiF3UGrFkDcsPRBHWGqQ20YpuOQNno7iL8N0FWauERw1 +dvxAGVwFfUznR3wc/eyGcnRhqQhlYPspukh0IVIyEbre3yVFSG/41GQYQfg08XYd +LYiiDUu1i515/GeDvYN5VcnZ4nMhPgqfxW4rEUZjI86p++bqwqGy8eOCivkzGV3A +IFWQwlvKKzU7tSdi3uHUq5v7xQsJrALdf67JVjCCGfUZa17O41vmm58L/vKhhL2Y +mLz/H004DPsB+CtWoLwqZ8Jmb1EHwqNbna3tGHn3n63j2cV7gykZFa/zXeuBbbJ/ +t4ZIojIEzwAVKA9Xzcl3wyGCRr62WJPEcOqe4kBYREuKd22juPEm9RQgciIIj0tP +eJVpD0QarGGzERsaq7pheAiWisO+Q4cLjF8Mb3/r89abnd4AQk6meabFJIE2dXWp +LZy3I6FkNQ7L7LxNOILhnaWzWGdOBVwHeAAxfbLOzM22ewj7oUwBCRpsBJ8zl2PL +VhUjX6N26YoiR9gE1RBaVrwRkYLmkyGvrowCDoZVPxvJqbfIESQE42zGB9DbEPNp +WXCnzAg5cIjNC31We274yLE7dpNPVRXPJCRhtp7noorWVzDdKB+dFvg08bIir6Vj +1gxy8DvuZE1Gq9vqx38V7Cy2MrSpsgapw5mli4n5cMafE7Ty3j5pBJFF2f3jUn6B +7MjCrKp1d8v6MEy18J/Ugu1Lytb92LMcNtWBKmqyCSxekrUB9/FC2hWqOpdwRI6q +QMWkwshjyEhmlr2PAkBPM4uVzUFc9lBw1GzOUChkr9jiINdbsUSRJrwZ32Nc3gRY +yKzWbEELPSgRcXwXgH3QqZukvmk2tBMTIxilXqKTLmd7t/AEnIhkbqC0pfnyChyU +YlFkme0RpAXpgbDJgv+Vk+1/1s6gyaNSzT4s2Q340WIO +-----END ENCRYPTED PRIVATE KEY----- diff --git a/lib/public_key/test/pbe_SUITE_data/pbes2_aes_256_enc_key.pem b/lib/public_key/test/pbe_SUITE_data/pbes2_aes_256_enc_key.pem new file mode 100644 index 0000000000..050337aead --- /dev/null +++ b/lib/public_key/test/pbe_SUITE_data/pbes2_aes_256_enc_key.pem @@ -0,0 +1,30 @@ +-----BEGIN ENCRYPTED PRIVATE KEY----- +MIIFLTBXBgkqhkiG9w0BBQ0wSjApBgkqhkiG9w0BBQwwHAQI4MxgpDiHxQcCAggA +MAwGCCqGSIb3DQIJBQAwHQYJYIZIAWUDBAEqBBA2g/L8XmlK2axDkeYJCltnBIIE +0C3+NQ93DzEK/9qicy1sj0Vag1M7AeJjTGGpatETCxM+eHjk4kNNeDeMV5+EmCSu +Db4P48uvHOBGGCcqdjnQovfQsAh81GWxgF3yqpd4OKn2RubMLO4/Qu+zGtt/XRKz +T0pyHHBu6hyPSOhad2SIjKWuaHepwxGYaejLP83sy6yhm0sEmyBUn4nGSTOROcqR +wd7EbwU2PYUcrRGGxtChU7MUNt48wBO50Xmri1ssPPtZV6MHio4IoIz4hqzCjvAc +VE1BqAvNIJ7icpdnL8Jqq0lfwEmGjFCkAjgov5fNW9I1b44jE2Tv5LM2urMH8InQ +9qNjTHozYQhHAk9nX4cmMgHsIhkOd7Z2M+nz8Hd1tj9DmBNOr5XbfyctgVntaMB4 +GGnThuNlX8d5giOKOcaNPMpLU1jtfDcb73mEhwCYcdo1PM0rjrYZ7qetjXJW/oHs +Nl/hIZIRpMuCRVuXHml4G+ziKbMnXUN8sbtvgkQatYFHFQOhAqZeyzWp8SlDcfqb +Zt0LlZVJEhKUYzZgKoe7SmR1rXTTCfYeB75PddyYwVgf/IkT6HJ/y1apGOP6/UJ8 +7UV6zssQA35gMsYDT36sH2hAQvA/cOFxSxrip0gm0xXOeFF0gbyZWbFqk0aULaeF +rbBoMe28akxdE4eD06b+TP2NguUGP72l3TPOlG4PQVScweMw9L3oPXOVj4Vbbd0y +DenNvRHlWIwOh/y7ADTHSWq9CE45QDBvFaTcn43JQWD8xCmhAhI/9H+fhAQUhABm +P5QoJLE2IGo8A+Gi7rfgYQb3fCgqcn8azsRJzozhE+oXxMvxEESejYTtm26FNmLg +ONTWysF9BiaKHt2IXwRX97691wZqv5wJEaxeeJxfVQ6MlAHoEDXe49VxGN4zFXuq +Yb71JdQDgM94jwc/PoUwFH2ALSkIciiKwU0xfFpptycl4qWpy9m7QTIKw0DjgCfg +MuySPRGM5jn3yVg72ux2Qf9MKNEybWjZ+Se9MJ1IZmZK5eOo6L2JsFCc0nRn908E +vn4gAgUfMxyCZ1ygXfxINVAixR+6KPHsz1QTIxTZkrlnXRsuEu1ZfBSHzmXESvJo +3I9PkP/Iekg1FBpB5xxd7mXwCj17EWqYXWsLnfd8SblMjRYd64q7hfx0oU/MJ1wi +KadkGcyAGVRyleJRBR0LleYj/2sDihrRQY4zu5UtzSMFMH0XWjSWk5+ZQb+z3iDc +Ud4GHcHiuTMH+i03ApZGWLN9v93za/15fsnZogstgJkaHxizTz5JuCkRf15xd8+O +EH77Tsfizjp+h2NF/wcr4OSD0i+H0mwZWajpZ3UmSeJ0BFK6ODEbmVycrInpHo3n +zyMJnEDTJXL3HUwZSLjO5e5cNaB+75tdHrj2yJtRLuaJFr02b0EO1MUYfuUuqlK4 +7mg7FkBsimW+CXkoLRjHYK88ibT3G+rZ/STf4S/jxiRjBi06FAql3H02K5i1umgB +0BaaQei0Z8wQxMeTEnGzL+OcJeqDA1ZRFeXe7DNGsX1jeTYKPHA/Dr2IdZqyiCr2 +xh6e7RJuUe4D2liXW8LlMdwhN/7xSinA031PgBmb8XzSRmfdHhytFkA8PiM5T2ew +NR3qXBJ/G7BuRa/t26RuKI3BMVoBQPhGx80ds10uJjxq +-----END ENCRYPTED PRIVATE KEY----- diff --git a/lib/public_key/vsn.mk b/lib/public_key/vsn.mk index c68806d856..0912367006 100644 --- a/lib/public_key/vsn.mk +++ b/lib/public_key/vsn.mk @@ -1 +1 @@ -PUBLIC_KEY_VSN = 1.6.6 +PUBLIC_KEY_VSN = 1.6.6.1 diff --git a/lib/runtime_tools/doc/src/notes.xml b/lib/runtime_tools/doc/src/notes.xml index 58a2a66c4b..ae1470f8fd 100644 --- a/lib/runtime_tools/doc/src/notes.xml +++ b/lib/runtime_tools/doc/src/notes.xml @@ -32,6 +32,27 @@ <p>This document describes the changes made to the Runtime_Tools application.</p> +<section><title>Runtime_Tools 1.13.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The function <c>dbg:n/1</c> used a local fun to set up a + tracer on a remote node. This works fine as long as the + remote node is running exactly the same version of + Erlang/OTP but does not work at all otherwise. This is + fixed by exporting the relevant function and by calling + this function on the remote node to set up remote + tracing.</p> + <p> + Own Id: OTP-16930 Aux Id: ERL-1371, GH-4396 </p> + </item> + </list> + </section> + +</section> + <section><title>Runtime_Tools 1.13.2</title> <section><title>Improvements and New Features</title> diff --git a/lib/runtime_tools/src/dbg.erl b/lib/runtime_tools/src/dbg.erl index 92938ed5c1..41410bebf0 100644 --- a/lib/runtime_tools/src/dbg.erl +++ b/lib/runtime_tools/src/dbg.erl @@ -34,7 +34,7 @@ -export([fun2ms/1]). %% Local exports --export([erlang_trace/3,get_info/0,deliver_and_flush/1]). +-export([erlang_trace/3,get_info/0,deliver_and_flush/1,do_relay/2]). %% Debug exports -export([wrap_presort/2, wrap_sort/2, wrap_postsort/1, wrap_sortfix/2, @@ -942,9 +942,9 @@ erlang_trace(AtomPid, How, Flags) -> relay(Node,To) when Node /= node() -> case get(Node) of - undefined -> + undefined -> S = self(), - Pid = spawn_link(Node, fun() -> do_relay(S,To) end), + Pid = spawn_link(Node, dbg, do_relay, [S, To]), receive {started,Remote} -> put(Node, {Pid,Remote}) end, {ok,Pid}; {_Relay,PortOrPid} -> diff --git a/lib/runtime_tools/vsn.mk b/lib/runtime_tools/vsn.mk index fa2f338ec2..ebc5f6b7a1 100644 --- a/lib/runtime_tools/vsn.mk +++ b/lib/runtime_tools/vsn.mk @@ -1 +1 @@ -RUNTIME_TOOLS_VSN = 1.13.2 +RUNTIME_TOOLS_VSN = 1.13.2.1 diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index 9503060140..723e64c3e8 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -30,6 +30,116 @@ <file>notes.xml</file> </header> +<section><title>Ssh 4.7.6.6</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The idle_time timer was not cancelled when a channel was + opened within the timeout time on an empty connection + that have had channels previously.</p> + <p> + Own Id: OTP-17279</p> + </item> + </list> + </section> + +</section> + +<section><title>Ssh 4.7.6.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix decoder bug.</p> + <p> + Own Id: OTP-16904</p> + </item> + </list> + </section> + +</section> + +<section><title>Ssh 4.7.6.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Potential hazard between re-keying decision and socket + close.</p> + <p> + Own Id: OTP-16462 Aux Id: ERIERL-464 </p> + </item> + </list> + </section> + +</section> + +<section><title>Ssh 4.7.6.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed that <c>ssh_connection:send</c> could allocate a + large amount of memory if given an iolist() as input + data.</p> + <p> + Own Id: OTP-16373</p> + </item> + <item> + <p> + Safe atom conversions.</p> + <p> + Own Id: OTP-16375</p> + </item> + <item> + <p> + Constant time comparisons added.</p> + <p> + Own Id: OTP-16376</p> + </item> + </list> + </section> + +</section> + +<section><title>Ssh 4.7.6.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The ssh cli (e.g shell) server behaved strangely when + characters were inserted in a string so that the last + characters tried to wrap the line.</p> + <p> + Own Id: OTP-14849 Aux Id: ERL-545 </p> + </item> + </list> + </section> + +</section> + +<section><title>Ssh 4.7.6.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed a possible SSH logging crash if there was a problem + in an early stage of session setup.</p> + <p> + Own Id: OTP-15962 Aux Id: ERL-990 </p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 4.7.6</title> <section><title>Improvements and New Features</title> diff --git a/lib/ssh/doc/src/ssh_connection.xml b/lib/ssh/doc/src/ssh_connection.xml index 2a701929f6..ea98512d15 100644 --- a/lib/ssh/doc/src/ssh_connection.xml +++ b/lib/ssh/doc/src/ssh_connection.xml @@ -366,7 +366,7 @@ <type> <v>ConnectionRef = connection_ref()</v> <v>ChannelId = channel_id()</v> - <v>Data = binary()</v> + <v>Data = iodata()</v> <v>Type = ssh_data_type_code()</v> <v>Timeout = timeout()</v> </type> diff --git a/lib/ssh/src/ssh.app.src b/lib/ssh/src/ssh.app.src index 410061cded..62e8df0074 100644 --- a/lib/ssh/src/ssh.app.src +++ b/lib/ssh/src/ssh.app.src @@ -44,7 +44,7 @@ {env, []}, {mod, {ssh_app, []}}, {runtime_dependencies, [ - "crypto-4.2", + "crypto-4.4.2.2", "erts-6.0", "kernel-3.0", "public_key-1.5.2", diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index 9632168e65..b9813b6b5c 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -462,7 +462,7 @@ check_password(User, Password, Opts, Ssh) -> case ?GET_OPT(pwdfun, Opts) of undefined -> Static = get_password_option(Opts, User), - {Password == Static, Ssh}; + {crypto:equal_const_time(Password,Static), Ssh}; Checker when is_function(Checker,2) -> {Checker(User, Password), Ssh}; diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl index af51356355..a2fda7ac4d 100644 --- a/lib/ssh/src/ssh_cli.erl +++ b/lib/ssh/src/ssh_cli.erl @@ -357,7 +357,7 @@ insert_chars([], {Buf, BufTail, Col}, _Tty) -> insert_chars(Chars, {Buf, BufTail, Col}, Tty) -> {NewBuf, _NewBufTail, WriteBuf, NewCol} = conv_buf(Chars, Buf, [], [], Col), - M = move_cursor(NewCol + length(BufTail), NewCol, Tty), + M = move_cursor(special_at_width(NewCol+length(BufTail), Tty), NewCol, Tty), {[WriteBuf, BufTail | M], {NewBuf, BufTail, NewCol}}. %%% delete characters at current position, (backwards if negative argument) @@ -372,7 +372,7 @@ delete_chars(N, {Buf, BufTail, Col}, Tty) -> % N < 0 NewBuf = nthtail(-N, Buf), NewCol = case Col + N of V when V >= 0 -> V; _ -> 0 end, M1 = move_cursor(Col, NewCol, Tty), - M2 = move_cursor(NewCol + length(BufTail) - N, NewCol, Tty), + M2 = move_cursor(special_at_width(NewCol+length(BufTail)-N, Tty), NewCol, Tty), {[M1, BufTail, lists:duplicate(-N, $ ) | M2], {NewBuf, BufTail, NewCol}}. @@ -429,6 +429,10 @@ move_cursor(From, To, #ssh_pty{width=Width, term=Type}) -> end, [Tcol | Trow]. +%%% Caution for line "breaks" +special_at_width(From0, #ssh_pty{width=Width}) when (From0 rem Width) == 0 -> From0 - 1; +special_at_width(From0, _) -> From0. + %% %%% write out characters %% %%% make sure that there is data to send %% %%% before calling ssh_connection:send diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index 83f85b1d8e..dd79205224 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -265,14 +265,17 @@ exit_status(ConnectionHandler, Channel, Status) -> %%% ssh_connection:send (executed in the ssh_connection_state machine) %%% -channel_data(ChannelId, DataType, Data, Connection, From) when is_list(Data)-> - channel_data(ChannelId, DataType, l2b(Data), Connection, From); - -channel_data(ChannelId, DataType, Data, +channel_data(ChannelId, DataType, Data0, #connection{channel_cache = Cache} = Connection, From) -> case ssh_client_channel:cache_lookup(Cache, ChannelId) of #channel{remote_id = Id, sent_close = false} = Channel0 -> + Data = + try iolist_to_binary(Data0) + catch + _:_ -> + unicode:characters_to_binary(Data0) + end, {SendList, Channel} = update_send_window(Channel0#channel{flow_control = From}, DataType, Data, Connection), @@ -1241,26 +1244,3 @@ request_reply_or_data(#channel{local_id = ChannelId, user = ChannelPid}, false -> {[{channel_data, ChannelPid, Reply}], Connection} end. - - - -%%%---------------------------------------------------------------- -%%% l(ist)2b(inary) -%%% -l2b(L) when is_integer(hd(L)) -> - try list_to_binary(L) - of - B -> B - catch - _:_ -> - unicode:characters_to_binary(L) - end; -l2b([H|T]) -> - << (l2b(H))/binary, (l2b(T))/binary >>; -l2b(B) when is_binary(B) -> - B; -l2b([]) -> - <<>>. - - - diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 8f32966a12..5d2f6382a0 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -386,16 +386,24 @@ init_connection_handler(Role, Socket, Opts) -> D); {stop, Error} -> - Sups = ?GET_INTERNAL_OPT(supervisors, Opts), - C = #connection{system_supervisor = proplists:get_value(system_sup, Sups), - sub_system_supervisor = proplists:get_value(subsystem_sup, Sups), - connection_supervisor = proplists:get_value(connection_sup, Sups) - }, + D = try + %% Only servers have supervisorts defined in Opts + Sups = ?GET_INTERNAL_OPT(supervisors, Opts), + #connection{system_supervisor = proplists:get_value(system_sup, Sups), + sub_system_supervisor = proplists:get_value(subsystem_sup, Sups), + connection_supervisor = proplists:get_value(connection_sup, Sups) + } + of + C -> + #data{connection_state=C} + catch + _:_ -> + #data{connection_state=#connection{}} + end, gen_statem:enter_loop(?MODULE, [], {init_error,Error}, - #data{connection_state=C, - socket=Socket}) + D#data{socket=Socket}) end. @@ -1441,8 +1449,13 @@ handle_event(info, {'DOWN', _Ref, process, ChannelPid, _Reason}, _, D) -> end, [], Cache), {keep_state, D, cond_set_idle_timer(D)}; -handle_event({timeout,idle_time}, _Data, _StateName, _D) -> - {stop, {shutdown, "Timeout"}}; +handle_event({timeout,idle_time}, _Data, _StateName, D) -> + case ssh_client_channel:cache_info(num_entries, cache(D)) of + 0 -> + {stop, {shutdown, "Timeout"}}; + _ -> + keep_state_and_data + end; %%% So that terminate will be run when supervisor is shutdown handle_event(info, {'EXIT', _Sup, Reason}, StateName, _) -> @@ -1550,7 +1563,7 @@ terminate({shutdown,"Connection closed"}, _StateName, D) -> terminate({shutdown,{init,Reason}}, StateName, D) -> %% Error in initiation. "This error should not occur". - log(error, D, io_lib:format("Shutdown in init (StateName=~p): ~p~n",[StateName,Reason])), + log(error, D, "Shutdown in init (StateName=~p): ~p~n", [StateName,Reason]), stop_subsystem(D), close_transport(D); @@ -1919,14 +1932,21 @@ pause_renegotiate_timers(State, D) -> {{timeout,check_data_size}, infinity, none} ]}. check_data_rekeying(Role, D) -> - {ok, [{send_oct,SocketSentTotal}]} = inet:getstat(D#data.socket, [send_oct]), - SentSinceRekey = SocketSentTotal - D#data.last_size_rekey, - {_RekeyTimeout,MaxSent} = ?GET_OPT(rekey_limit, (D#data.ssh_params)#ssh.opts), - case check_data_rekeying_dbg(SentSinceRekey, MaxSent) of - true -> - start_rekeying(Role, D#data{last_size_rekey = SocketSentTotal}); - _ -> - %% Not enough data sent for a re-negotiation. Restart timer. + case inet:getstat(D#data.socket, [send_oct]) of + {ok, [{send_oct,SocketSentTotal}]} -> + SentSinceRekey = SocketSentTotal - D#data.last_size_rekey, + {_RekeyTimeout,MaxSent} = ?GET_OPT(rekey_limit, (D#data.ssh_params)#ssh.opts), + case check_data_rekeying_dbg(SentSinceRekey, MaxSent) of + true -> + start_rekeying(Role, D#data{last_size_rekey = SocketSentTotal}); + _ -> + %% Not enough data sent for a re-negotiation. Restart timer. + {keep_state, D, {{timeout,check_data_size}, ?REKEY_DATA_TIMOUT, none}} + end; + {error,_} -> + %% Socket closed, but before this module has handled that. Maybe + %% it is in the message queue. + %% Just go on like if there was not enough data transmitted to start re-keying: {keep_state, D, {{timeout,check_data_size}, ?REKEY_DATA_TIMOUT, none}} end. @@ -1952,12 +1972,12 @@ send_disconnect(Code, Reason, DetailedText, Module, Line, StateName, D0) -> call_disconnectfun_and_log_cond(LogMsg, DetailedText, Module, Line, StateName, D) -> case disconnect_fun(LogMsg, D) of void -> - log(info, D, - io_lib:format("~s~n" - "State = ~p~n" - "Module = ~p, Line = ~p.~n" - "Details:~n ~s~n", - [LogMsg, StateName, Module, Line, DetailedText])); + log(info, D, + "~s~n" + "State = ~p~n" + "Module = ~p, Line = ~p.~n" + "Details:~n ~s~n", + [LogMsg, StateName, Module, Line, DetailedText]); _ -> ok end. @@ -2021,6 +2041,9 @@ fold_keys(Keys, Fun, Extra) -> end, [], Keys). %%%---------------------------------------------------------------- +log(Tag, D, Format, Args) -> + log(Tag, D, io_lib:format(Format,Args)). + log(Tag, D, Reason) -> case atom_to_list(Tag) of % Dialyzer-technical reasons... "error" -> do_log(error_msg, Reason, D); @@ -2028,36 +2051,56 @@ log(Tag, D, Reason) -> "info" -> do_log(info_msg, Reason, D) end. -do_log(F, Reason, #data{ssh_params = #ssh{role = Role} = S - }) -> - VSN = - case application:get_key(ssh,vsn) of - {ok,Vsn} -> Vsn; - undefined -> "" - end, - PeerVersion = - case Role of - server -> S#ssh.c_version; - client -> S#ssh.s_version - end, - CryptoInfo = - try - [{_,_,CI}] = crypto:info_lib(), - <<"(",CI/binary,")">> + +do_log(F, Reason0, #data{ssh_params = S}) -> + Reason = + try io_lib:format("~s",[Reason0]) + of _ -> Reason0 catch - _:_ -> "" - end, - Other = - case Role of - server -> "Client"; - client -> "Server" + _:_ -> io_lib:format("~p",[Reason0]) end, - error_logger:F("Erlang SSH ~p ~s ~s.~n" - "~s: ~p~n" - "~s~n", - [Role, VSN, CryptoInfo, - Other, PeerVersion, - Reason]). + case S of + #ssh{role = Role} when Role==server ; + Role==client -> + {PeerRole,PeerVersion} = + case Role of + server -> {"Client", S#ssh.c_version}; + client -> {"Server", S#ssh.s_version} + end, + error_logger:F("Erlang SSH ~p ~s ~s.~n" + "~s: ~p~n" + "~s~n", + [Role, + ssh_log_version(), crypto_log_info(), + PeerRole, PeerVersion, + Reason]); + _ -> + error_logger:F("Erlang SSH ~s ~s.~n" + "~s~n", + [ssh_log_version(), crypto_log_info(), + Reason]) + end. + +crypto_log_info() -> + try + [{_,_,CI}] = crypto:info_lib(), + case crypto:info_fips() of + enabled -> + <<"(",CI/binary,". FIPS enabled)">>; + not_enabled -> + <<"(",CI/binary,". FIPS available but not enabled)">>; + _ -> + <<"(",CI/binary,")">> + end + catch + _:_ -> "" + end. + +ssh_log_version() -> + case application:get_key(ssh,vsn) of + {ok,Vsn} -> Vsn; + undefined -> "" + end. %%%---------------------------------------------------------------- not_connected_filter({connection_reply, _Data}) -> true; diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl index d95e58c1bb..75ba29e74d 100644 --- a/lib/ssh/src/ssh_message.erl +++ b/lib/ssh/src/ssh_message.erl @@ -566,8 +566,12 @@ bin_foldr(Fun, Acc, Bin) -> bin_foldl(_, Acc, <<>>) -> Acc; bin_foldl(Fun, Acc0, Bin0) -> - {Bin,Acc} = Fun(Bin0,Acc0), - bin_foldl(Fun, Acc, Bin). + case Fun(Bin0,Acc0) of + {Bin0,Acc0} -> + Acc0; + {Bin,Acc} -> + bin_foldl(Fun, Acc, Bin) + end. %%%---------------------------------------------------------------- decode_keyboard_interactive_prompts(<<>>, Acc) -> diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 9ff20454cd..1a5b9afa68 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -236,7 +236,7 @@ is_valid_mac(_, _ , #ssh{recv_mac_size = 0}) -> true; is_valid_mac(Mac, Data, #ssh{recv_mac = Algorithm, recv_mac_key = Key, recv_sequence = SeqNum}) -> - Mac == mac(Algorithm, Key, SeqNum, Data). + crypto:equal_const_time(Mac, mac(Algorithm, Key, SeqNum, Data)). format_version({Major,Minor}, SoftwareVersion) -> "SSH-" ++ integer_to_list(Major) ++ "." ++ @@ -1100,9 +1100,21 @@ alg_final(rcv, SSH0) -> select_all(CL, SL) when length(CL) + length(SL) < ?MAX_NUM_ALGORITHMS -> - A = CL -- SL, %% algortihms only used by client + %% algortihms only used by client + %% NOTE: an algorithm occuring more than once in CL will still be present + %% in CLonly. This is not a problem for nice clients. + CLonly = CL -- SL, + %% algorithms used by client and server (client pref) - lists:map(fun(ALG) -> list_to_atom(ALG) end, (CL -- A)); + lists:foldr(fun(ALG, Acc) -> + try [list_to_existing_atom(ALG) | Acc] + catch + %% If an malicious client uses the same non-existing algorithm twice, + %% we will end up here + _:_ -> Acc + end + end, [], (CL -- CLonly)); + select_all(CL, SL) -> Error = lists:concat(["Received too many algorithms (",length(CL),"+",length(SL)," >= ",?MAX_NUM_ALGORITHMS,")."]), ?DISCONNECT(?SSH_DISCONNECT_PROTOCOL_ERROR, @@ -1678,7 +1690,7 @@ decrypt(#ssh{decrypt = 'chacha20-poly1305@openssh.com', {_,PolyKey} = crypto:stream_encrypt(crypto:stream_init(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>), <<0:32/unit:8>>), - case equal_const_time(Ctag, crypto:poly1305(PolyKey, <<AAD/binary,Ctext/binary>>)) of + case crypto:equal_const_time(Ctag, crypto:poly1305(PolyKey, <<AAD/binary,Ctext/binary>>)) of true -> %% MAC is ok, decode IV2 = <<1:8/little-unit:8, Seq:8/unit:8>>, @@ -1953,7 +1965,10 @@ valid_key_sha_alg(_, _) -> false. valid_key_sha_alg_ec(OID, Alg) -> Curve = public_key:oid2ssh_curvename(OID), - Alg == list_to_atom("ecdsa-sha2-" ++ binary_to_list(Curve)). + try Alg == list_to_existing_atom("ecdsa-sha2-" ++ binary_to_list(Curve)) + catch + _:_ -> false + end. -dialyzer({no_match, public_algo/1}). @@ -1964,7 +1979,10 @@ public_algo({ed_pub, ed25519,_}) -> 'ssh-ed25519'; public_algo({ed_pub, ed448,_}) -> 'ssh-ed448'; public_algo({#'ECPoint'{},{namedCurve,OID}}) -> Curve = public_key:oid2ssh_curvename(OID), - list_to_atom("ecdsa-sha2-" ++ binary_to_list(Curve)). + try list_to_existing_atom("ecdsa-sha2-" ++ binary_to_list(Curve)) + catch + _:_ -> undefined + end. sha('ssh-rsa') -> sha; @@ -1998,7 +2016,7 @@ sha('curve25519-sha256@libssh.org' ) -> sha256; sha('curve448-sha512') -> sha512; sha(x25519) -> sha256; sha(x448) -> sha512; -sha(Str) when is_list(Str), length(Str)<50 -> sha(list_to_atom(Str)). +sha(Str) when is_list(Str), length(Str)<50 -> sha(list_to_existing_atom(Str)). mac_key_bytes('hmac-sha1') -> 20; @@ -2133,18 +2151,6 @@ same(Algs) -> [{client2server,Algs}, {server2client,Algs}]. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% Compare two binaries in a timing safe maner. -%%% The time spent in comparing should not be different depending on where in the binaries they differ. -%%% This is to avoid a certain side-channel attac. -equal_const_time(X1, X2) -> equal_const_time(X1, X2, true). - -equal_const_time(<<B1,R1/binary>>, <<B2,R2/binary>>, Truth) -> - equal_const_time(R1, R2, Truth and (B1 == B2)); -equal_const_time(<<>>, <<>>, Truth) -> - Truth; -equal_const_time(_, _, _) -> - false. - %%%-------- Remove CR, LF and following characters from a line trim_tail(Str) -> diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 5de6d52092..4f01c9c0ea 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -604,43 +604,40 @@ exec_compressed(Config) when is_list(Config) -> end. %%-------------------------------------------------------------------- -%%% Idle timeout test, client -idle_time_client(Config) -> - SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), - UserDir = proplists:get_value(priv_dir, Config), +%%% Idle timeout test +idle_time_client(Config) -> idle_time_common([], [{idle_time, 2000}], Config). - {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {user_dir, UserDir}, - {failfun, fun ssh_test_lib:failfun/2}]), - ConnectionRef = - ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, - {user_dir, UserDir}, - {user_interaction, false}, - {idle_time, 2000}]), - {ok, Id} = ssh_connection:session_channel(ConnectionRef, 1000), - ssh_connection:close(ConnectionRef, Id), - receive - after 10000 -> - {error, closed} = ssh_connection:session_channel(ConnectionRef, 1000) - end, - ssh:stop_daemon(Pid). +idle_time_server(Config) -> idle_time_common([{idle_time, 2000}], [], Config). -%%-------------------------------------------------------------------- -%%% Idle timeout test, server -idle_time_server(Config) -> + +idle_time_common(DaemonExtraOpts, ClientExtraOpts, Config) -> SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), UserDir = proplists:get_value(priv_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {user_dir, UserDir}, - {idle_time, 2000}, - {failfun, fun ssh_test_lib:failfun/2}]), + {failfun, fun ssh_test_lib:failfun/2} + | DaemonExtraOpts + ]), ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, {user_dir, UserDir}, - {user_interaction, false}]), - {ok, Id} = ssh_connection:session_channel(ConnectionRef, 1000), - ssh_connection:close(ConnectionRef, Id), + {user_interaction, false} + | ClientExtraOpts + ]), + {ok, Id1} = ssh_sftp:start_channel(ConnectionRef), + {ok, Id2} = ssh_sftp:start_channel(ConnectionRef), + ssh_sftp:stop_channel(Id2), + timer:sleep(2500), + {ok, Id3} = ssh_sftp:start_channel(ConnectionRef), + ssh_sftp:stop_channel(Id1), + ssh_sftp:stop_channel(Id3), + timer:sleep(1000), + {ok, Id4} = ssh_sftp:start_channel(ConnectionRef), + timer:sleep(2500), + {ok, Id5} = ssh_sftp:start_channel(ConnectionRef), + ssh_sftp:stop_channel(Id4), + ssh_sftp:stop_channel(Id5), receive after 10000 -> {error, closed} = ssh_connection:session_channel(ConnectionRef, 1000) diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 837da27ab0..d28ffb8b25 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,4 +1,4 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 4.7.6 +SSH_VSN = 4.7.6.6 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index 01323aaa1d..4a8f9bc461 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -27,6 +27,121 @@ </header> <p>This document describes the changes made to the SSL application.</p> +<section><title>SSL 9.2.3.7</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Data deliver with ssl:recv/2,3 could fail for when using + packet mode. This has been fixed by correcting the flow + control handling of passive sockets when packet mode is + used.</p> + <p> + Own Id: OTP-16764</p> + </item> + </list> + </section> + +</section> + +<section><title>SSL 9.2.3.6</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix timing bug that could cause ssl sockets to become + unresponsive after an ssl:recv/3 call timed out</p> + <p> + Own Id: OTP-16619 Aux Id: ERL-1213 </p> + </item> + </list> + </section> + +</section> + +<section><title>SSL 9.2.3.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Handling of zero size fragments in TLS could cause an + infinite loop. This has now been corrected.</p> + <p> + Own Id: OTP-15328 Aux Id: ERIERL-379 </p> + </item> + </list> + </section> + +</section> + +<section><title>SSL 9.2.3.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Hibernation now works as expected in all cases, was + accidently broken by optimization efforts.</p> + <p> + Own Id: OTP-15910</p> + </item> + </list> + </section> + +</section> + +<section><title>SSL 9.2.3.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Correct handshake handling, might cause strange symptoms + such as ASN.1 certificate decoding issues.</p> + <p> + Own Id: OTP-15879 Aux Id: ERL-968 </p> + </item> + </list> + </section> + +</section> + +<section><title>SSL 9.2.3.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Returned "alert error string" is now same as logged alert + string</p> + <p> + Own Id: OTP-15844</p> + </item> + </list> + </section> + +</section> + +<section><title>SSL 9.2.3.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Correct solution for retaining tcp flow control OTP-15802 + (ERL-934) as to not break ssl:recv as reported in + (ERL-938)</p> + <p> + Own Id: OTP-15823 Aux Id: ERL-934, ERL-938 </p> + </item> + </list> + </section> + +</section> + <section><title>SSL 9.2.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 2c6b71c97a..721689da8b 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -50,7 +50,7 @@ -export([encode_alert/3, send_alert/2, send_alert_in_connection/2, close/5, protocol_name/0]). %% Data handling --export([next_record/1, socket/4, setopts/3, getopts/3]). +-export([socket/4, setopts/3, getopts/3]). %% gen_statem state functions -export([init/3, error/3, downgrade/3, %% Initiation and take down states @@ -434,12 +434,12 @@ init({call, From}, {start, Timeout}, HelloVersion = dtls_record:hello_version(Version, SslOpts#ssl_options.versions), State1 = prepare_flight(State0#state{connection_env = CEnv#connection_env{negotiated_version = Version}}), {State2, Actions} = send_handshake(Hello, State1#state{connection_env = CEnv#connection_env{negotiated_version = HelloVersion}}), - State3 = State2#state{connection_env = CEnv#connection_env{negotiated_version = Version}, %% RequestedVersion + State = State2#state{connection_env = CEnv#connection_env{negotiated_version = Version}, %% RequestedVersion session = Session0#session{session_id = Hello#client_hello.session_id}, start_or_recv_from = From}, - {Record, State} = next_record(State3), - next_event(hello, Record, State, [{{timeout, handshake}, Timeout, close} | Actions]); + + next_event(hello, no_record, State, [{{timeout, handshake}, Timeout, close} | Actions]); init({call, _} = Type, Event, #state{static_env = #static_env{role = server}, protocol_specific = PS} = State) -> Result = gen_handshake(?FUNCTION_NAME, Type, Event, @@ -497,9 +497,8 @@ hello(internal, #client_hello{cookie = <<>>, %% negotiated. VerifyRequest = dtls_handshake:hello_verify_request(Cookie, ?HELLO_VERIFY_REQUEST_VERSION), State1 = prepare_flight(State0#state{connection_env = CEnv#connection_env{negotiated_version = Version}}), - {State2, Actions} = send_handshake(VerifyRequest, State1), - {Record, State} = next_record(State2), - next_event(?FUNCTION_NAME, Record, + {State, Actions} = send_handshake(VerifyRequest, State1), + next_event(?FUNCTION_NAME, no_record, State#state{handshake_env = HsEnv#handshake_env{ tls_handshake_history = ssl_handshake:init_handshake_history()}}, @@ -701,12 +700,10 @@ connection(internal, #hello_request{}, #state{static_env = #static_env{host = Ho HelloVersion = dtls_record:hello_version(Version, SslOpts#ssl_options.versions), State1 = prepare_flight(State0), {State2, Actions} = send_handshake(Hello, State1#state{connection_env = CEnv#connection_env{negotiated_version = HelloVersion}}), - {Record, State} = - next_record( - State2#state{protocol_specific = PS#{flight_state => initial_flight_state(DataTag)}, - session = Session0#session{session_id - = Hello#client_hello.session_id}}), - next_event(hello, Record, State, Actions); + State = State2#state{protocol_specific = PS#{flight_state => initial_flight_state(DataTag)}, + session = Session0#session{session_id + = Hello#client_hello.session_id}}, + next_event(hello, no_record, State, Actions); connection(internal, #client_hello{} = Hello, #state{static_env = #static_env{role = server}, handshake_env = #handshake_env{allow_renegotiate = true} = HsEnv} = State) -> %% Mitigate Computational DoS attack diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 7c1d0a3829..00a7f0a53a 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -82,7 +82,9 @@ protocol_extensions/0, session_id/0, error_alert/0, - srp_param_type/0]). + tls_alert/0, + srp_param_type/0, + named_curve/0]). %% ------------------------------------------------------------------------------------------------------- @@ -128,7 +130,8 @@ -type legacy_hash() :: md5. --type sign_algo() :: rsa | dsa | ecdsa. +-type sign_algo() :: rsa | dsa | ecdsa. % exported + -type kex_algo() :: rsa | dhe_rsa | dhe_dss | ecdhe_ecdsa | ecdh_ecdsa | ecdh_rsa | @@ -173,7 +176,7 @@ sect163r2 | secp160k1 | secp160r1 | - secp160r2. + secp160r2. % exported -type srp_param_type() :: srp_1024 | srp_1536 | @@ -213,7 +216,7 @@ bad_certificate_status_response | bad_certificate_hash_value | unknown_psk_identity | - no_application_protocol. + no_application_protocol. % exported %% ------------------------------------------------------------------------------------------------------- -type common_option() :: {protocol, protocol()} | diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl index 2a20d13cd5..81167b5ba3 100644 --- a/lib/ssl/src/ssl_alert.erl +++ b/lib/ssl/src/ssl_alert.erl @@ -32,7 +32,11 @@ -include("ssl_record.hrl"). -include("ssl_internal.hrl"). --export([decode/1, own_alert_txt/1, alert_txt/1, reason_code/2]). +-export([decode/1, + own_alert_txt/1, + alert_txt/1, + alert_txt/4, + reason_code/4]). %%==================================================================== %% Internal application API @@ -48,20 +52,29 @@ decode(Bin) -> decode(Bin, [], 0). %%-------------------------------------------------------------------- -%% -spec reason_code(#alert{}, client | server) -> -%% {tls_alert, unicode:chardata()} | closed. -%-spec reason_code(#alert{}, client | server) -> closed | {essl, string()}. +-spec reason_code(#alert{}, client | server, ProtocolName::string(), StateName::atom()) -> + {tls_alert, {atom(), unicode:chardata()}} | closed. %% %% Description: Returns the error reason that will be returned to the %% user. %%-------------------------------------------------------------------- -reason_code(#alert{description = ?CLOSE_NOTIFY}, _) -> +reason_code(#alert{description = ?CLOSE_NOTIFY}, _, _, _) -> closed; -reason_code(#alert{description = Description, role = Role} = Alert, Role) -> - {tls_alert, {description_atom(Description), own_alert_txt(Alert)}}; -reason_code(#alert{description = Description} = Alert, Role) -> - {tls_alert, {description_atom(Description), alert_txt(Alert#alert{role = Role})}}. +reason_code(#alert{description = Description, role = Role} = Alert, Role, ProtocolName, StateName) -> + Txt = lists:flatten(alert_txt(ProtocolName, Role, StateName, own_alert_txt(Alert))), + {tls_alert, {description_atom(Description), Txt}}; +reason_code(#alert{description = Description} = Alert, Role, ProtocolName, StateName) -> + Txt = lists:flatten(alert_txt(ProtocolName, Role, StateName, alert_txt(Alert))), + {tls_alert, {description_atom(Description), Txt}}. + +%%-------------------------------------------------------------------- +-spec alert_txt(string(), server | client, StateNam::atom(), string()) -> string(). +%% +%% Description: Generates alert text for log or string part of error return. +%%-------------------------------------------------------------------- +alert_txt(ProtocolName, Role, StateName, Txt) -> + io_lib:format("~s ~p: In state ~p ~s\n", [ProtocolName, Role, StateName, Txt]). %%-------------------------------------------------------------------- -spec own_alert_txt(#alert{}) -> string(). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index fbbe0a49c8..2142450a17 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -327,32 +327,33 @@ prf(ConnectionPid, Secret, Label, Seed, WantedLength) -> %%==================================================================== %% Alert and close handling %%==================================================================== -handle_own_alert(Alert, _, StateName, +handle_own_alert(Alert0, _, StateName, #state{static_env = #static_env{role = Role, protocol_cb = Connection}, ssl_options = SslOpts} = State) -> try %% Try to tell the other side - send_alert(Alert, StateName, State) + send_alert(Alert0, StateName, State) catch _:_ -> %% Can crash if we are in a uninitialized state ignore end, try %% Try to tell the local user - log_alert(SslOpts#ssl_options.log_alert, Role, Connection:protocol_name(), StateName, Alert#alert{role = Role}), + Alert = Alert0#alert{role = Role}, + log_alert(SslOpts#ssl_options.log_alert, Role, Connection:protocol_name(), StateName, Alert), handle_normal_shutdown(Alert,StateName, State) catch _:_ -> ok end, {stop, {shutdown, own_alert}, State}. -handle_normal_shutdown(Alert, _, #state{static_env = #static_env{role = Role, - socket = Socket, - transport_cb = Transport, - protocol_cb = Connection, - tracker = Tracker}, - handshake_env = #handshake_env{renegotiation = {false, first}}, - start_or_recv_from = StartFrom} = State) -> +handle_normal_shutdown(Alert, StateName, #state{static_env = #static_env{role = Role, + socket = Socket, + transport_cb = Transport, + protocol_cb = Connection, + tracker = Tracker}, + handshake_env = #handshake_env{renegotiation = {false, first}}, + start_or_recv_from = StartFrom} = State) -> Pids = Connection:pids(State), - alert_user(Pids, Transport, Tracker,Socket, StartFrom, Alert, Role, Connection); + alert_user(Pids, Transport, Tracker,Socket, StartFrom, Alert, Role, StateName, Connection); handle_normal_shutdown(Alert, StateName, #state{static_env = #static_env{role = Role, socket = Socket, @@ -363,9 +364,9 @@ handle_normal_shutdown(Alert, StateName, #state{static_env = #static_env{role = socket_options = Opts, start_or_recv_from = RecvFrom} = State) -> Pids = Connection:pids(State), - alert_user(Pids, Transport, Tracker, Socket, StateName, Opts, Pid, RecvFrom, Alert, Role, Connection). + alert_user(Pids, Transport, Tracker, Socket, StateName, Opts, Pid, RecvFrom, Alert, Role, StateName, Connection). -handle_alert(#alert{level = ?FATAL} = Alert, StateName, +handle_alert(#alert{level = ?FATAL} = Alert0, StateName, #state{static_env = #static_env{role = Role, socket = Socket, host = Host, @@ -379,10 +380,11 @@ handle_alert(#alert{level = ?FATAL} = Alert, StateName, session = Session, socket_options = Opts} = State) -> invalidate_session(Role, Host, Port, Session), + Alert = Alert0#alert{role = opposite_role(Role)}, log_alert(SslOpts#ssl_options.log_alert, Role, Connection:protocol_name(), - StateName, Alert#alert{role = opposite_role(Role)}), + StateName, Alert), Pids = Connection:pids(State), - alert_user(Pids, Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, Role, Connection), + alert_user(Pids, Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, Role, StateName, Connection), {stop, {shutdown, normal}, State}; handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, @@ -392,13 +394,14 @@ handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, StateName, State) -> handle_normal_shutdown(Alert, StateName, State), {stop,{shutdown, peer_close}, State}; -handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, +handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert0, StateName, #state{static_env = #static_env{role = Role, protocol_cb = Connection}, handshake_env = #handshake_env{renegotiation = {true, internal}}, ssl_options = SslOpts} = State) -> + Alert = Alert0#alert{role = opposite_role(Role)}, log_alert(SslOpts#ssl_options.log_alert, Role, - Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), + Connection:protocol_name(), StateName, Alert), handle_normal_shutdown(Alert, StateName, State), {stop,{shutdown, peer_close}, State}; @@ -442,8 +445,7 @@ handle_alert(#alert{level = ?WARNING} = Alert, StateName, passive_receive(State0 = #state{user_data_buffer = {_,BufferSize,_}}, StateName, Connection, StartTimerAction) -> case BufferSize of 0 -> - {Record, State} = Connection:next_record(State0), - Connection:next_event(StateName, Record, State, StartTimerAction); + Connection:next_event(StateName, no_record, State0, StartTimerAction); _ -> case read_application_data(<<>>, State0) of {stop, _, _} = ShutdownError -> @@ -610,7 +612,8 @@ read_application_dist_data(DHandle, Front0, BufferSize, Rear0, Bin0) -> <<SizeA:32, DataA:SizeA/binary, SizeB:32, DataB:SizeB/binary, SizeC:32, DataC:SizeC/binary, - SizeD:32, DataD:SizeD/binary, Rest/binary>> -> + SizeD:32, DataD:SizeD/binary, Rest/binary>> + when 0 < SizeA, 0 < SizeB, 0 < SizeC, 0 < SizeD -> %% We have 4 complete packets in the first binary erlang:dist_ctrl_put_data(DHandle, DataA), erlang:dist_ctrl_put_data(DHandle, DataB), @@ -620,7 +623,8 @@ read_application_dist_data(DHandle, Front0, BufferSize, Rear0, Bin0) -> DHandle, Front0, BufferSize - (4*4+SizeA+SizeB+SizeC+SizeD), Rear0, Rest); <<SizeA:32, DataA:SizeA/binary, SizeB:32, DataB:SizeB/binary, - SizeC:32, DataC:SizeC/binary, Rest/binary>> -> + SizeC:32, DataC:SizeC/binary, Rest/binary>> + when 0 < SizeA, 0 < SizeB, 0 < SizeC -> %% We have 3 complete packets in the first binary erlang:dist_ctrl_put_data(DHandle, DataA), erlang:dist_ctrl_put_data(DHandle, DataB), @@ -628,7 +632,8 @@ read_application_dist_data(DHandle, Front0, BufferSize, Rear0, Bin0) -> read_application_dist_data( DHandle, Front0, BufferSize - (3*4+SizeA+SizeB+SizeC), Rear0, Rest); <<SizeA:32, DataA:SizeA/binary, - SizeB:32, DataB:SizeB/binary, Rest/binary>> -> + SizeB:32, DataB:SizeB/binary, Rest/binary>> + when 0 < SizeA, 0 < SizeB -> %% We have 2 complete packets in the first binary erlang:dist_ctrl_put_data(DHandle, DataA), erlang:dist_ctrl_put_data(DHandle, DataB), @@ -639,13 +644,13 @@ read_application_dist_data(DHandle, Front0, BufferSize, Rear0, Bin0) -> %% Basic one packet code path <<Size:32, Data:Size/binary, Rest/binary>> -> %% We have a complete packet in the first binary - erlang:dist_ctrl_put_data(DHandle, Data), + 0 < Size andalso erlang:dist_ctrl_put_data(DHandle, Data), read_application_dist_data(DHandle, Front0, BufferSize - (4+Size), Rear0, Rest); <<Size:32, FirstData/binary>> when 4+Size =< BufferSize -> %% We have a complete packet in the buffer %% - fetch the missing content from the buffer front {Data,Front,Rear} = iovec_from_front(Size - byte_size(FirstData), Front0, Rear0, [FirstData]), - erlang:dist_ctrl_put_data(DHandle, Data), + 0 < Size andalso erlang:dist_ctrl_put_data(DHandle, Data), read_application_dist_data(DHandle, Front, BufferSize - (4+Size), Rear); <<Bin/binary>> -> %% In OTP-21 the match context reuse optimization fails if we use Bin0 in recursion, so here we @@ -661,23 +666,61 @@ read_application_dist_data(DHandle, Front0, BufferSize, Rear0, Bin0) -> %% contains enough data to maybe form a packet %% - fetch a tiny binary from the buffer front to complete the length field {LengthField,Front,Rear} = - iovec_from_front(4 - byte_size(IncompleteLengthField), Front0, Rear0, [IncompleteLengthField]), + case IncompleteLengthField of + <<>> -> + iovec_from_front(4, Front0, Rear0, []); + _ -> + iovec_from_front( + 4 - byte_size(IncompleteLengthField), Front0, Rear0, [IncompleteLengthField]) + end, LengthBin = iolist_to_binary(LengthField), read_application_dist_data(DHandle, Front, BufferSize, Rear, LengthBin); <<IncompleteLengthField/binary>> -> %% We do not have enough data in the buffer to even form a length field - await more data - {[IncompleteLengthField|Front0],BufferSize,Rear0} + case IncompleteLengthField of + <<>> -> + {Front0,BufferSize,Rear0}; + _ -> + {[IncompleteLengthField|Front0],BufferSize,Rear0} + end end end. +iovec_from_front(0, Front, Rear, Acc) -> + {lists:reverse(Acc),Front,Rear}; iovec_from_front(Size, [], Rear, Acc) -> - iovec_from_front(Size, lists:reverse(Rear), [], Acc); + case Rear of + %% Avoid lists:reverse/1 for simple cases. + %% Case clause for [] to avoid infinite loop. + [_] -> + iovec_from_front(Size, Rear, [], Acc); + [Bin2,Bin1] -> + iovec_from_front(Size, [Bin1,Bin2], [], Acc); + [Bin3,Bin2,Bin1] -> + iovec_from_front(Size, [Bin1,Bin2,Bin3], [], Acc); + [_,_,_|_] = Rear -> + iovec_from_front(Size, lists:reverse(Rear), [], Acc) + end; +iovec_from_front(Size, [Bin|Front], Rear, []) -> + case Bin of + <<Last:Size/binary>> -> % Just enough + {[Last],Front,Rear}; + <<Last:Size/binary, Rest/binary>> -> % More than enough, split here + {[Last],[Rest|Front],Rear}; + <<>> -> % Not enough, skip empty binaries + iovec_from_front(Size, Front, Rear, []); + <<_/binary>> -> % Not enough + BinSize = byte_size(Bin), + iovec_from_front(Size - BinSize, Front, Rear, [Bin]) + end; iovec_from_front(Size, [Bin|Front], Rear, Acc) -> case Bin of <<Last:Size/binary>> -> % Just enough {lists:reverse(Acc, [Last]),Front,Rear}; <<Last:Size/binary, Rest/binary>> -> % More than enough, split here {lists:reverse(Acc, [Last]),[Rest|Front],Rear}; + <<>> -> % Not enough, skip empty binaries + iovec_from_front(Size, Front, Rear, Acc); <<_/binary>> -> % Not enough BinSize = byte_size(Bin), iovec_from_front(Size - BinSize, Front, Rear, [Bin|Acc]) @@ -1188,10 +1231,8 @@ cipher(internal, #finished{verify_data = Data} = Finished, cipher(internal, #next_protocol{selected_protocol = SelectedProtocol}, #state{static_env = #static_env{role = server}, handshake_env = #handshake_env{expecting_finished = true, - expecting_next_protocol_negotiation = true} = HsEnv} = State0, Connection) -> - {Record, State} = - Connection:next_record(State0), - Connection:next_event(?FUNCTION_NAME, Record, + expecting_next_protocol_negotiation = true} = HsEnv} = State, Connection) -> + Connection:next_event(?FUNCTION_NAME, no_record, State#state{handshake_env = HsEnv#handshake_env{negotiated_protocol = SelectedProtocol, expecting_next_protocol_negotiation = false}}); cipher(internal, #change_cipher_spec{type = <<1>>}, #state{handshake_env = HsEnv, connection_states = ConnectionStates0} = @@ -1442,7 +1483,7 @@ handle_info({ErrorTag, Socket, econnaborted}, StateName, } = State) when StateName =/= connection -> Pids = Connection:pids(State), alert_user(Pids, Transport, Tracker,Socket, - StartFrom, ?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), Role, Connection), + StartFrom, ?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), Role, StateName, Connection), {stop, {shutdown, normal}, State}; handle_info({ErrorTag, Socket, Reason}, StateName, #state{static_env = #static_env{socket = Socket, @@ -2861,22 +2902,22 @@ send_user(Pid, Msg) -> Pid ! Msg, ok. -alert_user(Pids, Transport, Tracker, Socket, connection, Opts, Pid, From, Alert, Role, Connection) -> - alert_user(Pids, Transport, Tracker, Socket, Opts#socket_options.active, Pid, From, Alert, Role, Connection); -alert_user(Pids, Transport, Tracker, Socket,_, _, _, From, Alert, Role, Connection) -> - alert_user(Pids, Transport, Tracker, Socket, From, Alert, Role, Connection). +alert_user(Pids, Transport, Tracker, Socket, connection, Opts, Pid, From, Alert, Role, StateName, Connection) -> + alert_user(Pids, Transport, Tracker, Socket, Opts#socket_options.active, Pid, From, Alert, Role, StateName, Connection); +alert_user(Pids, Transport, Tracker, Socket,_, _, _, From, Alert, Role, StateName, Connection) -> + alert_user(Pids, Transport, Tracker, Socket, From, Alert, Role, StateName, Connection). -alert_user(Pids, Transport, Tracker, Socket, From, Alert, Role, Connection) -> - alert_user(Pids, Transport, Tracker, Socket, false, no_pid, From, Alert, Role, Connection). +alert_user(Pids, Transport, Tracker, Socket, From, Alert, Role, StateName, Connection) -> + alert_user(Pids, Transport, Tracker, Socket, false, no_pid, From, Alert, Role, StateName, Connection). -alert_user(_, _, _, _, false = Active, Pid, From, Alert, Role, _) when From =/= undefined -> +alert_user(_, _, _, _, false = Active, Pid, From, Alert, Role, StateName, Connection) when From =/= undefined -> %% If there is an outstanding ssl_accept | recv %% From will be defined and send_or_reply will %% send the appropriate error message. - ReasonCode = ssl_alert:reason_code(Alert, Role), + ReasonCode = ssl_alert:reason_code(Alert, Role, Connection:protocol_name(), StateName), send_or_reply(Active, Pid, From, {error, ReasonCode}); -alert_user(Pids, Transport, Tracker, Socket, Active, Pid, From, Alert, Role, Connection) -> - case ssl_alert:reason_code(Alert, Role) of +alert_user(Pids, Transport, Tracker, Socket, Active, Pid, From, Alert, Role, StateName, Connection) -> + case ssl_alert:reason_code(Alert, Role, Connection:protocol_name(), StateName) of closed -> send_or_reply(Active, Pid, From, {ssl_closed, Connection:socket(Pids, Transport, Socket, Tracker)}); @@ -2887,10 +2928,10 @@ alert_user(Pids, Transport, Tracker, Socket, Active, Pid, From, Alert, Role, Con log_alert(true, Role, ProtocolName, StateName, #alert{role = Role} = Alert) -> Txt = ssl_alert:own_alert_txt(Alert), - error_logger:info_report(io_lib:format("~s ~p: In state ~p ~s\n", [ProtocolName, Role, StateName, Txt])); + error_logger:info_report(ssl_alert:alert_txt(ProtocolName, Role, StateName, Txt)); log_alert(true, Role, ProtocolName, StateName, Alert) -> Txt = ssl_alert:alert_txt(Alert), - error_logger:info_report(io_lib:format("~s ~p: In state ~p ~s\n", [ProtocolName, Role, StateName, Txt])); + error_logger:info_report(ssl_alert:alert_txt(ProtocolName, Role, StateName, Txt)); log_alert(false, _, _, _, _) -> ok. diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 29db1b07c4..dea78a876f 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -92,8 +92,8 @@ hello_request() -> #hello_request{}. %%-------------------------------------------------------------------- --spec server_hello(binary(), ssl_record:ssl_version(), ssl_record:connection_states(), - Extension::map()) -> #server_hello{}. +%%-spec server_hello(binary(), ssl_record:ssl_version(), ssl_record:connection_states(), +%% Extension::map()) -> #server_hello{}. %% %% Description: Creates a server hello message. %%-------------------------------------------------------------------- @@ -357,7 +357,7 @@ certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef, CertDbHandle, CertDbRef) end catch - error:{badmatch,{asn1, Asn1Reason}} -> + error:{badmatch,{error, {asn1, Asn1Reason}}} -> %% ASN-1 decode of certificate somehow failed ?ALERT_REC(?FATAL, ?CERTIFICATE_UNKNOWN, {failed_to_decode_certificate, Asn1Reason}); error:OtherReason -> diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 52e5db731a..2e53350eae 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -60,7 +60,7 @@ close/5, protocol_name/0]). %% Data handling --export([next_record/1, socket/4, setopts/3, getopts/3]). +-export([socket/4, setopts/3, getopts/3]). %% gen_statem state functions -export([init/3, error/3, downgrade/3, %% Initiation and take down states @@ -142,33 +142,79 @@ pids(#state{protocol_specific = #{sender := Sender}}) -> %%==================================================================== %% State transition handling %%==================================================================== -next_record(#state{handshake_env = +next_record(_, #state{handshake_env = #handshake_env{unprocessed_handshake_events = N} = HsEnv} = State) when N > 0 -> {no_record, State#state{handshake_env = HsEnv#handshake_env{unprocessed_handshake_events = N-1}}}; -next_record(#state{protocol_buffers = - #protocol_buffers{tls_cipher_texts = [_|_] = CipherTexts}, - connection_states = ConnectionStates, - ssl_options = #ssl_options{padding_check = Check}} = State) -> +next_record(_, #state{protocol_buffers = + #protocol_buffers{tls_cipher_texts = [_|_] = CipherTexts}, + connection_states = ConnectionStates, + ssl_options = #ssl_options{padding_check = Check}} = State) -> next_record(State, CipherTexts, ConnectionStates, Check); -next_record(#state{user_data_buffer = {_,0,_}, - protocol_buffers = #protocol_buffers{tls_cipher_texts = []}, - protocol_specific = #{active_n_toggle := true, - active_n := N} = ProtocolSpec, - static_env = #static_env{socket = Socket, - close_tag = CloseTag, - transport_cb = Transport} - } = State) -> +next_record(connection, #state{protocol_buffers = #protocol_buffers{tls_cipher_texts = []}, + protocol_specific = #{active_n_toggle := true} + } = State) -> + %% If ssl application user is not reading data wait to activate socket + flow_ctrl(State); + +next_record(_, #state{protocol_buffers = #protocol_buffers{tls_cipher_texts = []}, + protocol_specific = #{active_n_toggle := true} + } = State) -> + activate_socket(State); +next_record(_, State) -> + {no_record, State}. + +flow_ctrl(#state{user_data_buffer = {_,Size,_}, + socket_options = #socket_options{active = false, + packet = Packet}, + bytes_to_read = undefined} = State) when ((Packet =/= 0) orelse (Packet =/= raw)) + andalso Size =/= 0 -> + %% We need more data to complete the packet. + activate_socket(State); +flow_ctrl(#state{user_data_buffer = {_,Size,_}, + socket_options = #socket_options{active = false, + packet = Packet}, + bytes_to_read = BytesToRead} = State) when ((Packet =/= 0) orelse (Packet =/= raw)) -> + case (Size >= BytesToRead andalso Size =/= 0) of + true -> %% There is enough data bufferd + {no_record, State}; + false -> %% We need more data to complete the packet of <BytesToRead> size + activate_socket(State) + end; +flow_ctrl(#state{user_data_buffer = {_,Size,_}, + socket_options = #socket_options{active = false}, + bytes_to_read = undefined} = State) when Size =/= 0 -> + %% Passive mode wait for new recv request + {no_record, State}; +flow_ctrl(#state{user_data_buffer = {_,Size,_}, + socket_options = #socket_options{active = false}, + bytes_to_read = 0} = State) when Size =/= 0 -> + %% Passive mode no available bytes, get some + activate_socket(State); +flow_ctrl(#state{user_data_buffer = {_,Size,_}, + socket_options = #socket_options{active = false}, + bytes_to_read = BytesToRead} = State) when (Size >= BytesToRead) andalso + (BytesToRead > 0) -> + %% There is enough data bufferd + {no_record, State}; +flow_ctrl(State) -> + %% Active mode + activate_socket(State). + + +activate_socket(#state{protocol_specific = #{active_n_toggle := true, active_n := N} = ProtocolSpec, + static_env = #static_env{socket = Socket, + close_tag = CloseTag, + transport_cb = Transport} + } = State) -> case tls_socket:setopts(Transport, Socket, [{active, N}]) of - ok -> + ok -> {no_record, State#state{protocol_specific = ProtocolSpec#{active_n_toggle => false}}}; - _ -> + _ -> self() ! {CloseTag, Socket}, {no_record, State} - end; -next_record(State) -> - {no_record, State}. + end. %% Decipher next record and concatenate consecutive ?APPLICATION_DATA records into one %% @@ -200,28 +246,20 @@ next_record_done(#state{protocol_buffers = Buffers} = State, CipherTexts, Connec State#state{protocol_buffers = Buffers#protocol_buffers{tls_cipher_texts = CipherTexts}, connection_states = ConnectionStates}}. - next_event(StateName, Record, State) -> next_event(StateName, Record, State, []). %% next_event(StateName, no_record, State0, Actions) -> - case next_record(State0) of + case next_record(StateName, State0) of {no_record, State} -> - {next_state, StateName, State, Actions}; - {#ssl_tls{} = Record, State} -> - {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]}; - #alert{} = Alert -> - {next_state, StateName, State0, [{next_event, internal, Alert} | Actions]} + ssl_connection:hibernate_after(StateName, State, Actions); + {Record, State} -> + next_event(StateName, Record, State, Actions) end; -next_event(StateName, Record, State, Actions) -> - case Record of - no_record -> - {next_state, StateName, State, Actions}; - #ssl_tls{} = Record -> - {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]}; - #alert{} = Alert -> - {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} - end. +next_event(StateName, #ssl_tls{} = Record, State, Actions) -> + {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]}; +next_event(StateName, #alert{} = Alert, State, Actions) -> + {next_state, StateName, State, [{next_event, internal, Alert} | Actions]}. %%% TLS record protocol level application data messages @@ -272,8 +310,7 @@ handle_protocol_record(#ssl_tls{type = ?HANDSHAKE, fragment = Data}, _ -> HsEnv = State#state.handshake_env, {next_state, StateName, - State#state{protocol_buffers = Buffers, - handshake_env = + State#state{handshake_env = HsEnv#handshake_env{unprocessed_handshake_events = unprocessed_events(Events)}}, Events} end @@ -871,7 +908,7 @@ next_tls_record(Data, StateName, case tls_record:get_tls_records(Data, Versions, Buf0) of {Records, Buf1} -> CT1 = CT0 ++ Records, - next_record(State0#state{protocol_buffers = + next_record(StateName, State0#state{protocol_buffers = Buffers#protocol_buffers{tls_record_buffer = Buf1, tls_cipher_texts = CT1}}); #alert{} = Alert -> @@ -900,10 +937,18 @@ handle_info({Protocol, _, Data}, StateName, handle_info({PassiveTag, Socket}, StateName, #state{static_env = #static_env{socket = Socket, passive_tag = PassiveTag}, + start_or_recv_from = From, + protocol_buffers = #protocol_buffers{tls_cipher_texts = CTs}, protocol_specific = PS - } = State) -> - next_event(StateName, no_record, - State#state{protocol_specific = PS#{active_n_toggle => true}}); + } = State0) -> + case (From =/= undefined) andalso (CTs == []) of + true -> + {Record, State} = activate_socket(State0#state{protocol_specific = PS#{active_n_toggle => true}}), + next_event(StateName, Record, State); + false -> + next_event(StateName, no_record, + State0#state{protocol_specific = PS#{active_n_toggle => true}}) + end; handle_info({CloseTag, Socket}, StateName, #state{static_env = #static_env{socket = Socket, close_tag = CloseTag}, connection_env = #connection_env{negotiated_version = Version}, diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index 38022030ee..20598ea702 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -489,16 +489,27 @@ validate_tls_record_length(Versions, {_,Size0,_} = Q0, Acc, Type, Version, Lengt end. -binary_from_front(SplitSize, {Front,Size,Rear}) -> +binary_from_front(0, Q) -> + {<<>>, Q}; +binary_from_front(SplitSize, {Front,Size,Rear}) when SplitSize =< Size -> binary_from_front(SplitSize, Front, Size, Rear, []). %% -binary_from_front(SplitSize, [], Size, [_] = Rear, Acc) -> - %% Optimize a simple case - binary_from_front(SplitSize, Rear, Size, [], Acc); +%% SplitSize > 0 and there is at least SplitSize bytes buffered in Front and Rear binary_from_front(SplitSize, [], Size, Rear, Acc) -> - binary_from_front(SplitSize, lists:reverse(Rear), Size, [], Acc); + case Rear of + %% Avoid lists:reverse/1 for simple cases. + %% Case clause for [] to avoid infinite loop. + [_] -> + binary_from_front(SplitSize, Rear, Size, [], Acc); + [Bin2,Bin1] -> + binary_from_front(SplitSize, [Bin1,Bin2], Size, [], Acc); + [Bin3,Bin2,Bin1] -> + binary_from_front(SplitSize, [Bin1,Bin2,Bin3], Size, [], Acc); + [_,_,_|_] -> + binary_from_front(SplitSize, lists:reverse(Rear), Size, [], Acc) + end; binary_from_front(SplitSize, [Bin|Front], Size, Rear, []) -> - %% Optimize a frequent case + %% Optimize the frequent case when the accumulator is empty BinSize = byte_size(Bin), if SplitSize < BinSize -> diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 4452adaea7..b23ef74c50 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -3769,7 +3769,7 @@ hibernate(Config) -> ssl_test_lib:check_result(Server, ok, Client, ok), - timer:sleep(1500), + ct:sleep(1500), {current_function, {erlang, hibernate, 3}} = process_info(Pid, current_function), @@ -3805,6 +3805,8 @@ hibernate_right_away(Config) -> [{port, Port1}, {options, [{hibernate_after, 0}|ClientOpts]}]), ssl_test_lib:check_result(Server1, ok, Client1, ok), + + ct:sleep(1000), %% Schedule out {current_function, {erlang, hibernate, 3}} = process_info(Pid1, current_function), diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index e89104a999..653a8d58bd 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -89,7 +89,8 @@ tests() -> critical_extension_verify_server, critical_extension_verify_none, customize_hostname_check, - incomplete_chain + incomplete_chain, + long_chain ]. error_handling_tests()-> @@ -1156,6 +1157,44 @@ incomplete_chain(Config) when is_list(Config) -> ssl_test_lib:close(Server), ssl_test_lib:close(Client). +long_chain() -> + [{doc,"Test option verify_peer"}]. +long_chain(Config) when is_list(Config) -> + #{server_config := ServerConf, + client_config := ClientConf} = public_key:pkix_test_data(#{server_chain => #{root => [{key, ssl_test_lib:hardcode_rsa_key(1)}], + intermediates => [[{key, ssl_test_lib:hardcode_rsa_key(2)}], + [{key, ssl_test_lib:hardcode_rsa_key(3)}], + [{key, ssl_test_lib:hardcode_rsa_key(4)}]], + peer => [{key, ssl_test_lib:hardcode_rsa_key(5)}]}, + client_chain => #{root => [{key, ssl_test_lib:hardcode_rsa_key(3)}], + intermediates => [[{key, ssl_test_lib:hardcode_rsa_key(2)}]], + peer => [{key, ssl_test_lib:hardcode_rsa_key(1)}]}}), + [ServerRoot| _] = ServerCas = proplists:get_value(cacerts, ServerConf), + ClientCas = proplists:get_value(cacerts, ClientConf), + + Active = proplists:get_value(active, Config), + ReceiveFunction = proplists:get_value(receive_function, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, ReceiveFunction, []}}, + {options, [{active, Active}, {verify, verify_peer}, + {cacerts, [ServerRoot]} | + proplists:delete(cacerts, ServerConf)]}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, ReceiveFunction, []}}, + {options, [{active, Active}, + {verify, verify_peer}, + {depth, 5}, + {cacerts, ServerCas ++ ClientCas} | + proplists:delete(cacerts, ClientConf)]}]), + ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ diff --git a/lib/ssl/test/ssl_packet_SUITE.erl b/lib/ssl/test/ssl_packet_SUITE.erl index 6d26b2df33..b301afc09a 100644 --- a/lib/ssl/test/ssl_packet_SUITE.erl +++ b/lib/ssl/test/ssl_packet_SUITE.erl @@ -592,8 +592,8 @@ packet_baddata_active(Config) when is_list(Config) -> {packet, cdr} | ClientOpts]}]), receive - {Client, {other, {ssl_error, _Socket, - {invalid_packet, _}},{error,closed},1}} -> ok; + {Client, {ssl_error, _, {invalid_packet, _}}} -> + ok; Unexpected -> ct:fail({unexpected, Unexpected}) end, @@ -627,7 +627,8 @@ packet_baddata_passive(Config) when is_list(Config) -> ClientOpts]}]), receive - {Client, {other, {error, {invalid_packet, _}},{error,closed}, 1}} -> ok; + {Client, {error, {invalid_packet, _}}} -> + ok; Unexpected -> ct:fail({unexpected, Unexpected}) end, @@ -660,11 +661,11 @@ packet_size_active(Config) when is_list(Config) -> {packet, 4}, {packet_size, 10} | ClientOpts]}]), receive - {Client, {other, {ssl_error, _Socket, - {invalid_packet, _}},{error,closed},1}} -> ok; + {Client, {ssl_error, _, {invalid_packet, _}}}-> + ok; Unexpected -> ct:fail({unexpected, Unexpected}) - end, + end, ssl_test_lib:close(Server), ssl_test_lib:close(Client). @@ -695,7 +696,8 @@ packet_size_passive(Config) when is_list(Config) -> {packet, 4}, {packet_size, 30} | ClientOpts]}]), receive - {Client, {other, {error, {invalid_packet, _}},{error,closed},1}} -> ok; + {Client, {error, {invalid_packet, _}}} -> + ok; Unexpected -> ct:fail({unexpected, Unexpected}) end, @@ -2051,8 +2053,8 @@ passive_recv_packet(Socket, Data, N) -> case ssl:recv(Socket, 0) of {ok, Data} -> passive_recv_packet(Socket, Data, N-1); - Other -> - {other, Other, ssl:connection_information(Socket, [session_id, cipher_suite]), N} + {error, _} = Other -> + Other end. send(Socket,_, 0) -> @@ -2146,9 +2148,9 @@ active_packet(Socket, Data, N) -> active_packet(Socket, Data, N -1) end; {ssl, Socket, Data} -> - active_packet(Socket, Data, N -1); + active_packet(Socket, Data, N-1); Other -> - {other, Other, ssl:connection_information(Socket, [session_id, cipher_suite]),N} + Other end. assert_packet_opt(Socket, Type) -> diff --git a/lib/ssl/test/ssl_payload_SUITE.erl b/lib/ssl/test/ssl_payload_SUITE.erl index 27b9c258a0..2d0ffd03d7 100644 --- a/lib/ssl/test/ssl_payload_SUITE.erl +++ b/lib/ssl/test/ssl_payload_SUITE.erl @@ -48,21 +48,27 @@ groups() -> payload_tests() -> [server_echos_passive_small, + server_echos_passive_chunk_small, server_echos_active_once_small, server_echos_active_small, client_echos_passive_small, + client_echos_passive_chunk_small, client_echos_active_once_small, client_echos_active_small, server_echos_passive_big, + server_echos_passive_chunk_big, server_echos_active_once_big, server_echos_active_big, client_echos_passive_big, + client_echos_passive_chunk_big, client_echos_active_once_big, client_echos_active_big, server_echos_passive_huge, + server_echos_passive_chunk_huge, server_echos_active_once_huge, server_echos_active_huge, client_echos_passive_huge, + client_echos_passive_chunk_huge, client_echos_active_once_huge, client_echos_active_huge, client_active_once_server_close]. @@ -109,9 +115,11 @@ end_per_group(GroupName, Config) -> init_per_testcase(TestCase, Config) when TestCase == server_echos_passive_huge; + TestCase == server_echos_passive_chunk_huge; TestCase == server_echos_active_once_huge; TestCase == server_echos_active_huge; TestCase == client_echos_passive_huge; + TestCase == client_echos_passive_chunk_huge; TestCase == client_echos_active_once_huge; TestCase == client_echos_active_huge -> case erlang:system_info(system_architecture) of @@ -124,9 +132,11 @@ init_per_testcase(TestCase, Config) init_per_testcase(TestCase, Config) when TestCase == server_echos_passive_big; + TestCase == server_echos_passive_chunk_big; TestCase == server_echos_active_once_big; TestCase == server_echos_active_big; TestCase == client_echos_passive_big; + TestCase == client_echos_passive_chunk_big; TestCase == client_echos_active_once_big; TestCase == client_echos_active_big -> ct:timetrap({seconds, 60}), @@ -157,6 +167,22 @@ server_echos_passive_small(Config) when is_list(Config) -> %%-------------------------------------------------------------------- +server_echos_passive_chunk_small() -> + [{doc, "Client sends 1000 bytes in passive mode to server, that receives them in chunks, " + "sends them back, and closes."}]. + +server_echos_passive_chunk_small(Config) when is_list(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + %% + Data = binary:copy(<<"1234567890">>, 100), + server_echos_passive_chunk( + Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname). + + +%%-------------------------------------------------------------------- + server_echos_active_once_small() -> [{doc, "Client sends 1000 bytes in active once mode to server, that receives " " them, sends them back, and closes."}]. @@ -200,6 +226,21 @@ client_echos_passive_small(Config) when is_list(Config) -> Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname). %%-------------------------------------------------------------------- +client_echos_passive_chunk__small() -> + [{doc, "Server sends 1000 bytes in passive mode to client, that receives them in chunks, " + "sends them back, and closes."}]. + +client_echos_passive_chunk_small(Config) when is_list(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + %% + Data = binary:copy(<<"1234567890">>, 100), + client_echos_passive_chunk( + Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname). + + +%%-------------------------------------------------------------------- client_echos_active_once_small() -> ["Server sends 1000 bytes in active once mode to client, that receives " "them, sends them back, and closes."]. @@ -241,6 +282,19 @@ server_echos_passive_big(Config) when is_list(Config) -> Data = binary:copy(<<"1234567890">>, 5000), server_echos_passive( Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname). +%%-------------------------------------------------------------------- +server_echos_passive_chunk_big() -> + [{doc, "Client sends 50000 bytes to server in passive mode, that receives them, " + "sends them back, and closes."}]. + +server_echos_passive_chunk_big(Config) when is_list(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + %% + Data = binary:copy(<<"1234567890">>, 5000), + server_echos_passive_chunk( + Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname). %%-------------------------------------------------------------------- @@ -286,6 +340,22 @@ client_echos_passive_big(Config) when is_list(Config) -> client_echos_passive( Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname). + +%%-------------------------------------------------------------------- +client_echos_passive_chunk_big() -> + [{doc, "Server sends 50000 bytes to client in passive mode, that receives them, " + "sends them back, and closes."}]. + +client_echos_passive_chunk_big(Config) when is_list(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + %% + Data = binary:copy(<<"1234567890">>, 5000), + client_echos_passive_chunk( + Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname). + + %%-------------------------------------------------------------------- client_echos_active_once_big() -> [{doc, "Server sends 50000 bytes to client in active once mode, that receives" @@ -329,6 +399,20 @@ server_echos_passive_huge(Config) when is_list(Config) -> Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname). %%-------------------------------------------------------------------- +server_echos_passive_chunk_huge() -> + [{doc, "Client sends 500000 bytes to server in passive mode, that receives " + " them, sends them back, and closes."}]. + +server_echos_passive_chunk_huge(Config) when is_list(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + %% + Data = binary:copy(<<"1234567890">>, 50000), + server_echos_passive_chunk( + Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname). + +%%-------------------------------------------------------------------- server_echos_active_once_huge() -> [{doc, "Client sends 500000 bytes to server in active once mode, that receives " "them, sends them back, and closes."}]. @@ -369,7 +453,19 @@ client_echos_passive_huge(Config) when is_list(Config) -> Data = binary:copy(<<"1234567890">>, 50000), client_echos_passive( Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname). +%%-------------------------------------------------------------------- +client_echos_passive_chunk_huge() -> + [{doc, "Server sends 500000 bytes to client in passive mode, that receives " + "them, sends them back, and closes."}]. +client_echos_passive_chunk_huge(Config) when is_list(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + %% + Data = binary:copy(<<"1234567890">>, 50000), + client_echos_passive_chunk( + Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname). %%-------------------------------------------------------------------- client_echos_active_once_huge() -> [{doc, "Server sends 500000 bytes to client in active once mode, that receives " @@ -442,6 +538,28 @@ server_echos_passive( ssl_test_lib:close(Server), ssl_test_lib:close(Client). +server_echos_passive_chunk( + Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname) -> + Length = byte_size(Data), + Server = + ssl_test_lib:start_server( + [{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, echoer_chunk, [Length]}}, + {options, [{active, false}, {mode, binary} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client = + ssl_test_lib:start_client( + [{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, sender, [Data]}}, + {options, [{active, false}, {mode, binary} | ClientOpts]}]), + %% + ssl_test_lib:check_result(Server, ok, Client, ok), + %% + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). server_echos_active_once( Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname) -> @@ -513,6 +631,31 @@ client_echos_passive( ssl_test_lib:close(Server), ssl_test_lib:close(Client). + +client_echos_passive_chunk( + Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname) -> + Length = byte_size(Data), + Server = + ssl_test_lib:start_server( + [{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, sender, [Data]}}, + {options, [{active, false}, {mode, binary} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client = + ssl_test_lib:start_client( + [{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, echoer_chunk, [Length]}}, + {options, [{active, false}, {mode, binary} | ClientOpts]}]), + %% + ssl_test_lib:check_result(Server, ok, Client, ok), + %% + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + client_echos_active_once( Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname) -> Length = byte_size(Data), @@ -615,6 +758,10 @@ echoer(Socket, Size) -> ct:log("Echoer recv: ~p~n", [ssl:getopts(Socket, [active])]), echo_recv(Socket, Size * 100). +echoer_chunk(Socket, Size) -> + ct:log("Echoer recv: ~p~n", [ssl:getopts(Socket, [active])]), + echo_recv_chunk(Socket, Size, Size * 100). + echoer_active_once(Socket, Size) -> ct:log("Echoer active once: ~p~n", [ssl:getopts(Socket, [active])]), echo_active_once(Socket, Size * 100). @@ -632,6 +779,16 @@ echo_recv(Socket, Size) -> ok = ssl:send(Socket, Data), echo_recv(Socket, Size - byte_size(Data)). + +%% Receive Size bytes +echo_recv_chunk(_Socket, _, 0) -> + ok; +echo_recv_chunk(Socket, ChunkSize, Size) -> + {ok, Data} = ssl:recv(Socket, ChunkSize), + ok = ssl:send(Socket, Data), + echo_recv_chunk(Socket, ChunkSize, Size - ChunkSize). + + %% Receive Size bytes echo_active_once(_Socket, 0) -> ok; diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index c3e64e62d6..bfed7d6fda 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -440,14 +440,17 @@ check_result(Pid, Msg) -> end. check_server_alert(Pid, Alert) -> receive - {Pid, {error, {tls_alert, {Alert, _}}}} -> + {Pid, {error, {tls_alert, {Alert, STxt}}}} -> + check_server_txt(STxt), ok end. check_server_alert(Server, Client, Alert) -> receive - {Server, {error, {tls_alert, {Alert, _}}}} -> + {Server, {error, {tls_alert, {Alert, STxt}}}} -> + check_server_txt(STxt), receive - {Client, {error, {tls_alert, {Alert, _}}}} -> + {Client, {error, {tls_alert, {Alert, CTxt}}}} -> + check_client_txt(CTxt), ok; {Client, {error, closed}} -> ok @@ -455,20 +458,35 @@ check_server_alert(Server, Client, Alert) -> end. check_client_alert(Pid, Alert) -> receive - {Pid, {error, {tls_alert, {Alert, _}}}} -> + {Pid, {error, {tls_alert, {Alert, CTxt}}}} -> + check_client_txt(CTxt), ok end. check_client_alert(Server, Client, Alert) -> receive - {Client, {error, {tls_alert, {Alert, _}}}} -> + {Client, {error, {tls_alert, {Alert, CTxt}}}} -> + check_client_txt(CTxt), receive - {Server, {error, {tls_alert, {Alert, _}}}} -> + {Server, {error, {tls_alert, {Alert, STxt}}}} -> + check_server_txt(STxt), ok; {Server, {error, closed}} -> ok end end. +check_server_txt("TLS server" ++ _) -> + ok; +check_server_txt("DTLS server" ++ _) -> + ok; +check_server_txt(Txt) -> + ct:fail({expected_server, {got, Txt}}). +check_client_txt("TLS client" ++ _) -> + ok; +check_client_txt("DTLS client" ++ _) -> + ok; +check_client_txt(Txt) -> + ct:fail({expected_server, {got, Txt}}). wait_for_result(Server, ServerMsg, Client, ClientMsg) -> receive diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index b5545b71f7..5bf75d8c42 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 9.2.3 +SSL_VSN = 9.2.3.7 diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml index 7d8f0bf85c..543bee58be 100644 --- a/lib/stdlib/doc/src/notes.xml +++ b/lib/stdlib/doc/src/notes.xml @@ -31,6 +31,81 @@ </header> <p>This document describes the changes made to the STDLIB application.</p> +<section><title>STDLIB 3.8.2.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + <seealso marker="stdlib:re#run/3">re:run(Subject, RE, + [unicode])</seealso> returned <c>nomatch</c> instead of + failing with a <c>badarg</c> error exception when + <c>Subject</c> contained illegal utf8 and <c>RE</c> was + passed as a binary. This has been corrected along with + corrections of reduction counting in <c>re:run()</c> + error cases.</p> + <p> + Own Id: OTP-16553</p> + </item> + </list> + </section> + +</section> + +<section><title>STDLIB 3.8.2.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>A directory traversal vulnerability has been + eliminated in erl_tar. erl_tar will now refuse to extract + symlinks that points outside the targeted extraction + directory and will return + <c>{error,{Path,unsafe_symlink}}</c>. (Thanks to Eric + Meadows-Jönsson for the bug report and for suggesting a + fix.)</p> + <p> + Own Id: OTP-16441</p> + </item> + </list> + </section> + +</section> + +<section><title>STDLIB 3.8.2.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Fix a bug that could cause a loop when formatting + terms using the control sequences <c>p</c> or <c>P</c> + and limiting the output with the option + <c>chars_limit</c>. </p> + <p> + Own Id: OTP-15875 Aux Id: ERL-967 </p> + </item> + </list> + </section> + +</section> + +<section><title>STDLIB 3.8.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Fix a bug that could cause a failure when formatting + binaries using the control sequences <c>p</c> or <c>P</c> + and limiting the output with the option + <c>chars_limit</c>. </p> + <p> + Own Id: OTP-15847 Aux Id: ERL-957 </p> + </item> + </list> + </section> + +</section> + <section><title>STDLIB 3.8.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl index 7064fcacfa..74fc51ee35 100644 --- a/lib/stdlib/src/erl_tar.erl +++ b/lib/stdlib/src/erl_tar.erl @@ -1611,7 +1611,8 @@ write_extracted_element(#tar_header{name=Name0}=Header, Bin, Opts) -> create_extracted_dir(Name1, Opts); symlink -> read_verbose(Opts, "x ~ts~n", [Name0]), - create_symlink(Name1, Header#tar_header.linkname, Opts); + LinkName = safe_link_name(Header, Opts), + create_symlink(Name1, LinkName, Opts); Device when Device =:= char orelse Device =:= block -> %% char/block devices will be created as empty files %% and then have their major/minor device set later @@ -1639,6 +1640,52 @@ make_safe_path(Path, #read_opts{cwd=Cwd}) -> filename:absname(SafePath, Cwd) end. +safe_link_name(#tar_header{linkname=Path}, #read_opts{cwd=Cwd}) -> + case safe_relative_path_links(Path, Cwd) of + unsafe -> + throw({error,{Path,unsafe_symlink}}); + SafePath -> + SafePath + end. + +safe_relative_path_links(Path, Cwd) -> + case filename:pathtype(Path) of + relative -> safe_relative_path_links(filename:split(Path), Cwd, [], ""); + _ -> unsafe + end. + +safe_relative_path_links([Segment|Segments], Cwd, PrevSegments, Acc) -> + AccSegment = join(Acc, Segment), + case lists:member(AccSegment, PrevSegments) of + true -> + unsafe; + false -> + case file:read_link(join(Cwd, AccSegment)) of + {ok, LinkPath} -> + case filename:pathtype(LinkPath) of + relative -> + safe_relative_path_links(filename:split(LinkPath) ++ Segments, + Cwd, [AccSegment|PrevSegments], Acc); + _ -> + unsafe + end; + + {error, _} -> + case filename:safe_relative_path(join(Acc, Segment)) of + unsafe -> + unsafe; + NewAcc -> + safe_relative_path_links(Segments, Cwd, + [AccSegment|PrevSegments], NewAcc) + end + end + end; +safe_relative_path_links([], _Cwd, _PrevSegments, Acc) -> + Acc. + +join([], Path) -> Path; +join(Left, Right) -> filename:join(Left, Right). + create_regular(Name, NameInArchive, Bin, Opts) -> case write_extracted_file(Name, Bin, Opts) of not_written -> diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl index 8f2fd7ea8f..96b6ea338a 100644 --- a/lib/stdlib/src/io_lib_pretty.erl +++ b/lib/stdlib/src/io_lib_pretty.erl @@ -462,7 +462,9 @@ find_upper(Lower, Term, T, Dl, Dd, D, RF, Enc, Str) -> case If of {_, _, _Dots=0, _} -> % even if Len > T If; - {_, Len, _, _} when Len =< T, D1 < D orelse D < 0 -> + {_, _Len=T, _, _} -> % increasing the depth is meaningless + If; + {_, Len, _, _} when Len < T, D1 < D orelse D < 0 -> find_upper(If, Term, T, D1, Dd2, D, RF, Enc, Str); _ -> search_depth(Lower, If, Term, T, Dl, D1, RF, Enc, Str) @@ -795,6 +797,8 @@ printable_bin0(Bin, D, T, Enc) -> end, printable_bin(Bin, Len, D, Enc). +printable_bin(_Bin, 0, _D, _Enc) -> + false; printable_bin(Bin, Len, D, latin1) -> N = erlang:min(20, Len), L = binary_to_list(Bin, 1, N), diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index cd09872b87..4a8b994ca5 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -108,7 +108,7 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-3.0","kernel-6.0","erts-10.0","crypto-3.3", + {runtime_dependencies, ["sasl-3.0","kernel-6.0","erts-10.3.5.11","crypto-3.3", "compiler-5.0"]} ]}. diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src index 9a1b92a87c..30268b3a0a 100644 --- a/lib/stdlib/src/stdlib.appup.src +++ b/lib/stdlib/src/stdlib.appup.src @@ -44,7 +44,8 @@ {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, {<<"^3\\.8$">>,[restart_new_emulator]}, {<<"^3\\.8\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, - {<<"^3\\.8\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}], + {<<"^3\\.8\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^3\\.8\\.2(?:\\.[0-9]+)*$">>,[restart_new_emulator]}], [{<<"^3\\.4$">>,[restart_new_emulator]}, {<<"^3\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^3\\.4\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, @@ -62,4 +63,5 @@ {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, {<<"^3\\.8$">>,[restart_new_emulator]}, {<<"^3\\.8\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, - {<<"^3\\.8\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}. + {<<"^3\\.8\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^3\\.8\\.2(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}. diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 433b812fd5..f35b68f63a 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -1247,7 +1247,11 @@ t_select_delete(Config) when is_list(Config) -> %% Tests the ets:select_replace/2 BIF t_select_replace(Config) when is_list(Config) -> EtsMem = etsmem(), - Tables = fill_sets_int(10000) ++ fill_sets_int(10000, [{write_concurrency,true}]), + repeat_for_opts(fun do_select_replace/1), + verify_etsmem(EtsMem). + +do_select_replace(Opts) -> + Tables = fill_sets_intup(10000, Opts), TestFun = fun (Table, TableType) when TableType =:= bag -> % Operation not supported; bag implementation @@ -1256,80 +1260,80 @@ t_select_replace(Config) when is_list(Config) -> (Table, TableType) -> % Invalid replacement doesn't keep the key - MatchSpec1 = [{{'$1', '$2'}, + MatchSpec1 = [{{{'$1','$3'}, '$2'}, [{'=:=', {'band', '$1', 2#11}, 2#11}, {'=/=', {'hd', '$2'}, $x}], - [{{'$2', '$1'}}]}], + [{{{{'$2','$3'}}, '$1'}}]}], {'EXIT',{badarg,_}} = (catch ets:select_replace(Table, MatchSpec1)), % Invalid replacement doesn't keep the key (even though it would be the same value) - MatchSpec2 = [{{'$1', '$2'}, + MatchSpec2 = [{{{'$1','$3'}, '$2'}, [{'=:=', {'band', '$1', 2#11}, 2#11}], - [{{{'+', '$1', 0}, '$2'}}]}, - {{'$1', '$2'}, + [{{{{{'+', '$1', 0},'$3'}}, '$2'}}]}, + {{{'$1','$3'}, '$2'}, [{'=/=', {'band', '$1', 2#11}, 2#11}], - [{{{'-', '$1', 0}, '$2'}}]}], + [{{{{{'-', '$1', 0},'$3'}}, '$2'}}]}], {'EXIT',{badarg,_}} = (catch ets:select_replace(Table, MatchSpec2)), % Invalid replacement changes key to float equivalent - MatchSpec3 = [{{'$1', '$2'}, + MatchSpec3 = [{{{'$1','$3'}, '$2'}, [{'=:=', {'band', '$1', 2#11}, 2#11}, {'=/=', {'hd', '$2'}, $x}], - [{{{'*', '$1', 1.0}, '$2'}}]}], + [{{{{{'*', '$1', 1.0},'$3'}}, '$2'}}]}], {'EXIT',{badarg,_}} = (catch ets:select_replace(Table, MatchSpec3)), % Replacements are differently-sized tuples - MatchSpec4_A = [{{'$1','$2'}, + MatchSpec4_A = [{{{'$1','$3'},'$2'}, [{'<', {'rem', '$1', 5}, 2}], - [{{'$1', [$x | '$2'], stuff}}]}], - MatchSpec4_B = [{{'$1','$2','_'}, + [{{{{'$1','$3'}}, [$x | '$2'], stuff}}]}], + MatchSpec4_B = [{{{'$1','$3'},'$2','_'}, [], - [{{'$1','$2'}}]}], + [{{{{'$1','$3'}},'$2'}}]}], 4000 = ets:select_replace(Table, MatchSpec4_A), 4000 = ets:select_replace(Table, MatchSpec4_B), % Replacement is the same tuple - MatchSpec5 = [{{'$1', '$2'}, + MatchSpec5 = [{{{'$1','$3'}, '$2'}, [{'>', {'rem', '$1', 5}, 3}], ['$_']}], 2000 = ets:select_replace(Table, MatchSpec5), % Replacement reconstructs an equal tuple - MatchSpec6 = [{{'$1', '$2'}, + MatchSpec6 = [{{{'$1','$3'}, '$2'}, [{'>', {'rem', '$1', 5}, 3}], - [{{'$1', '$2'}}]}], + [{{{{'$1','$3'}}, '$2'}}]}], 2000 = ets:select_replace(Table, MatchSpec6), % Replacement uses {element,KeyPos,T} for key 2000 = ets:select_replace(Table, - [{{'$1', '$2'}, + [{{{'$1','$3'}, '$2'}, [{'>', {'rem', '$1', 5}, 3}], [{{{element, 1, '$_'}, '$2'}}]}]), % Replacement uses wrong {element,KeyPos,T} for key {'EXIT',{badarg,_}} = (catch ets:select_replace(Table, - [{{'$1', '$2'}, + [{{{'$1','$3'}, '$2'}, [], [{{{element, 2, '$_'}, '$2'}}]}])), check(Table, - fun ({N, [$x, C | _]}) when ((N rem 5) < 2) -> (C >= $0) andalso (C =< $9); - ({N, [C | _]}) when is_float(N) -> (C >= $0) andalso (C =< $9); - ({N, [C | _]}) when ((N rem 5) > 3) -> (C >= $0) andalso (C =< $9); + fun ({{N,_}, [$x, C | _]}) when ((N rem 5) < 2) -> (C >= $0) andalso (C =< $9); + ({{N,_}, [C | _]}) when is_float(N) -> (C >= $0) andalso (C =< $9); + ({{N,_}, [C | _]}) when ((N rem 5) > 3) -> (C >= $0) andalso (C =< $9); ({_, [C | _]}) -> (C >= $0) andalso (C =< $9) end, 10000), % Replace unbound range (>) - MatchSpec7 = [{{'$1', '$2'}, + MatchSpec7 = [{{{'$1','$3'}, '$2'}, [{'>', '$1', 7000}], - [{{'$1', {{gt_range, '$2'}}}}]}], + [{{{{'$1','$3'}}, {{gt_range, '$2'}}}}]}], 3000 = ets:select_replace(Table, MatchSpec7), % Replace unbound range (<) - MatchSpec8 = [{{'$1', '$2'}, + MatchSpec8 = [{{{'$1','$3'}, '$2'}, [{'<', '$1', 3000}], - [{{'$1', {{le_range, '$2'}}}}]}], + [{{{{'$1','$3'}}, {{le_range, '$2'}}}}]}], case TableType of ordered_set -> 2999 = ets:select_replace(Table, MatchSpec8); set -> 2999 = ets:select_replace(Table, MatchSpec8); @@ -1337,10 +1341,10 @@ t_select_replace(Config) when is_list(Config) -> end, % Replace bound range - MatchSpec9 = [{{'$1', '$2'}, + MatchSpec9 = [{{{'$1','$3'}, '$2'}, [{'>=', '$1', 3001}, {'<', '$1', 7000}], - [{{'$1', {{range, '$2'}}}}]}], + [{{{{'$1','$3'}}, {{range, '$2'}}}}]}], case TableType of ordered_set -> 3999 = ets:select_replace(Table, MatchSpec9); set -> 3999 = ets:select_replace(Table, MatchSpec9); @@ -1348,12 +1352,12 @@ t_select_replace(Config) when is_list(Config) -> end, % Replace particular keys - MatchSpec10 = [{{'$1', '$2'}, + MatchSpec10 = [{{{'$1','$3'}, '$2'}, [{'==', '$1', 3000}], - [{{'$1', {{specific1, '$2'}}}}]}, - {{'$1', '$2'}, + [{{{{'$1','$3'}}, {{specific1, '$2'}}}}]}, + {{{'$1','$3'}, '$2'}, [{'==', '$1', 7000}], - [{{'$1', {{specific2, '$2'}}}}]}], + [{{{{'$1','$3'}}, {{specific2, '$2'}}}}]}], case TableType of ordered_set -> 2 = ets:select_replace(Table, MatchSpec10); set -> 2 = ets:select_replace(Table, MatchSpec10); @@ -1361,11 +1365,11 @@ t_select_replace(Config) when is_list(Config) -> end, check(Table, - fun ({N, {gt_range, _}}) -> N > 7000; - ({N, {le_range, _}}) -> N < 3000; - ({N, {range, _}}) -> (N >= 3001) andalso (N < 7000); - ({N, {specific1, _}}) -> N == 3000; - ({N, {specific2, _}}) -> N == 7000 + fun ({{N,_}, {gt_range, _}}) -> N > 7000; + ({{N,_}, {le_range, _}}) -> N < 3000; + ({{N,_}, {range, _}}) -> (N >= 3001) andalso (N < 7000); + ({{N,_}, {specific1, _}}) -> N == 3000; + ({{N,_}, {specific2, _}}) -> N == 7000 end, 10000), @@ -1405,7 +1409,7 @@ t_select_replace(Config) when is_list(Config) -> ] end, - T2 = ets:new(x, []), + T2 = ets:new(x, Opts), [lists:foreach(fun({A, B}) -> %% just check that matchspec is accepted 0 = ets:select_replace(T2, [{{A, '$2', '$3'}, [], [{{B, '$3', '$2'}}]}]) @@ -1466,8 +1470,7 @@ t_select_replace(Config) when is_list(Config) -> ets:delete(T2), - - verify_etsmem(EtsMem). + ok. %% OTP-15346: Bug caused select_replace of bound key to corrupt static stack %% used by ets:next and ets:prev. @@ -2236,35 +2239,61 @@ update_counter_with_default_do(Opts) -> T1 = ets_new(a, [set | Opts]), %% Insert default object. 3 = ets:update_counter(T1, foo, 2, {beaufort,1}), + 1 = ets:info(T1, size), %% Increment. 5 = ets:update_counter(T1, foo, 2, {cabecou,1}), + 1 = ets:info(T1, size), %% Increment with list. [9] = ets:update_counter(T1, foo, [{2,4}], {camembert,1}), + 1 = ets:info(T1, size), %% Same with non-immediate key. 3 = ets:update_counter(T1, {foo,bar}, 2, {{chaource,chevrotin},1}), + 2 = ets:info(T1, size), 5 = ets:update_counter(T1, {foo,bar}, 2, {{cantal,comté},1}), + 2 = ets:info(T1, size), [9] = ets:update_counter(T1, {foo,bar}, [{2,4}], {{emmental,de,savoie},1}), + 2 = ets:info(T1, size), + %% default counter is not an integer. + {'EXIT',{badarg,_}} = (catch ets:update_counter(T1, qux, 3, {saint,félicien})), + 2 = ets:info(T1, size), + %% No third element in default value. + {'EXIT',{badarg,_}} = (catch ets:update_counter(T1, qux, [{3,1}], {roquefort,1})), + 2 = ets:info(T1, size), + %% Same with ordered set. T2 = ets_new(b, [ordered_set | Opts]), 3 = ets:update_counter(T2, foo, 2, {maroilles,1}), + 1 = ets:info(T2, size), 5 = ets:update_counter(T2, foo, 2, {mimolette,1}), + 1 = ets:info(T2, size), [9] = ets:update_counter(T2, foo, [{2,4}], {morbier,1}), + 1 = ets:info(T2, size), 3 = ets:update_counter(T2, {foo,bar}, 2, {{laguiole},1}), + 2 = ets:info(T2, size), 5 = ets:update_counter(T2, {foo,bar}, 2, {{saint,nectaire},1}), + 2 = ets:info(T2, size), [9] = ets:update_counter(T2, {foo,bar}, [{2,4}], {{rocamadour},1}), + 2 = ets:info(T2, size), %% Arithmetically-equal keys. 3 = ets:update_counter(T2, 1.0, 2, {1,1}), + 3 = ets:info(T2, size), 5 = ets:update_counter(T2, 1, 2, {1,1}), + 3 = ets:info(T2, size), 7 = ets:update_counter(T2, 1, 2, {1.0,1}), + 3 = ets:info(T2, size), %% Same with reversed type difference. 3 = ets:update_counter(T2, 2, 2, {2.0,1}), + 4 = ets:info(T2, size), 5 = ets:update_counter(T2, 2.0, 2, {2.0,1}), + 4 = ets:info(T2, size), 7 = ets:update_counter(T2, 2.0, 2, {2,1}), - %% bar is not an integer. + 4 = ets:info(T2, size), + %% default counter is not an integer. {'EXIT',{badarg,_}} = (catch ets:update_counter(T1, qux, 3, {saint,félicien})), + 4 = ets:info(T2, size), %% No third element in default value. {'EXIT',{badarg,_}} = (catch ets:update_counter(T1, qux, [{3,1}], {roquefort,1})), - + 4 = ets:info(T2, size), ok. update_counter_table_growth(_Config) -> @@ -4870,6 +4899,7 @@ make_table(Name, Options, Elements) -> T = ets_new(Name, Options), lists:foreach(fun(E) -> ets:insert(T, E) end, Elements), T. + filltabint(Tab,0) -> Tab; filltabint(Tab,N) -> @@ -4896,6 +4926,22 @@ xfilltabint(Tab,N) -> filltabint(Tab,N) end. +filltabintup(Tab,0) -> + Tab; +filltabintup(Tab,N) -> + ets:insert(Tab,{{N,integer_to_list(N)},integer_to_list(N)}), + filltabintup(Tab,N-1). + +filltabintup2(Tab,0) -> + Tab; +filltabintup2(Tab,N) -> + ets:insert(Tab,{{N + N rem 2,integer_to_list(N)},integer_to_list(N)}), + filltabintup2(Tab,N-1). +filltabintup3(Tab,0) -> + Tab; +filltabintup3(Tab,N) -> + ets:insert(Tab,{{N + N rem 2,integer_to_list(N + N rem 2)},integer_to_list(N + N rem 2)}), + filltabintup3(Tab,N-1). filltabstr(Tab,N) -> filltabstr(Tab,0,N). @@ -4941,6 +4987,19 @@ fill_sets_int(N,Opts) -> filltabint3(Tab4,N), [Tab1,Tab2,Tab3,Tab4]. +fill_sets_intup(N) -> + fill_sets_int(N,[]). +fill_sets_intup(N,Opts) -> + Tab1 = ets_new(xxx, [ordered_set|Opts]), + filltabintup(Tab1,N), + Tab2 = ets_new(xxx, [set|Opts]), + filltabintup(Tab2,N), + Tab3 = ets_new(xxx, [bag|Opts]), + filltabintup2(Tab3,N), + Tab4 = ets_new(xxx, [duplicate_bag|Opts]), + filltabintup3(Tab4,N), + [Tab1,Tab2,Tab3,Tab4]. + check_fun(_Tab,_Fun,'$end_of_table') -> ok; check_fun(Tab,Fun,Item) -> @@ -5864,7 +5923,8 @@ smp_select_delete(Config) when is_list(Config) -> smp_select_replace(Config) when is_list(Config) -> repeat_for_opts(fun smp_select_replace_do/1, - [[set,ordered_set,duplicate_bag]]). + [[set,ordered_set,duplicate_bag], + compressed]). smp_select_replace_do(Opts) -> T = ets_new(smp_select_replace, diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index 824f5d19f2..4ad28b6169 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -32,7 +32,7 @@ io_with_huge_message_queue/1, format_string/1, maps/1, coverage/1, otp_14178_unicode_atoms/1, otp_14175/1, otp_14285/1, limit_term/1, otp_14983/1, otp_15103/1, otp_15076/1, - otp_15159/1, otp_15639/1]). + otp_15159/1, otp_15639/1, otp_15847/1, otp_15875/1]). -export([pretty/2, trf/3]). @@ -65,7 +65,7 @@ all() -> io_lib_width_too_small, io_with_huge_message_queue, format_string, maps, coverage, otp_14178_unicode_atoms, otp_14175, otp_14285, limit_term, otp_14983, otp_15103, otp_15076, otp_15159, - otp_15639]. + otp_15639, otp_15847, otp_15875]. %% Error cases for output. error_1(Config) when is_list(Config) -> @@ -2680,3 +2680,13 @@ otp_15639(_Config) -> "\"12345678\"..." = pretty("123456789"++[x], UOpts), "[[...]|...]" = pretty(["1","2","3","4","5","6","7","8"], UOpts), ok. + +otp_15847(_Config) -> + T = {someRecord,<<"1234567890">>,some,more}, + "{someRecord,<<...>>,...}" = + pretty(T, [{chars_limit,20}, {encoding,latin1}]), + ok. + +otp_15875(_Config) -> + S = io_lib:format("~tp", [[{0, [<<"00">>]}]], [{chars_limit, 18}]), + "[{0,[<<48,...>>]}]" = lists:flatten(S). diff --git a/lib/stdlib/test/lists_SUITE.erl b/lib/stdlib/test/lists_SUITE.erl index 984b51e7ae..9a0fe4b5ca 100644 --- a/lib/stdlib/test/lists_SUITE.erl +++ b/lib/stdlib/test/lists_SUITE.erl @@ -2586,6 +2586,15 @@ subtract(Config) when is_list(Config) -> [1,2,3,4,5,6,7,8,9,9999,10000,20,21,22] = sub(lists:seq(1, 10000)++[20,21,22], lists:seq(10, 9998)), + %% ERL-986; an integer overflow relating to term comparison + %% caused subtraction to be inconsistent. + Ids = [2985095936,47540628,135460048,1266126295,240535295, + 115724671,161800351,4187206564,4178142725,234897063, + 14773162,6662515191,133150693,378034895,1874402262, + 3507611978,22850922,415521280,253360400,71683243], + + [] = id(Ids) -- id(Ids), + %% Floats/integers. [42.0,42.0] = sub([42.0,42,42.0], [42,42,42]), [1,2,3,4,43.0] = sub([1,2,3,4,5,42.0,43.0], [42.0,5]), @@ -2613,6 +2622,8 @@ subtract(Config) when is_list(Config) -> ok. +id(I) -> I. + sub_non_matching(A, B) -> A = sub(A, B). diff --git a/lib/stdlib/test/re_SUITE.erl b/lib/stdlib/test/re_SUITE.erl index c9ef9da990..afab0cdcb9 100644 --- a/lib/stdlib/test/re_SUITE.erl +++ b/lib/stdlib/test/re_SUITE.erl @@ -28,7 +28,8 @@ pcre_compile_workspace_overflow/1,re_infinite_loop/1, re_backwards_accented/1,opt_dupnames/1,opt_all_names/1,inspect/1, opt_no_start_optimize/1,opt_never_utf/1,opt_ucp/1, - match_limit/1,sub_binaries/1,copt/1]). + match_limit/1,sub_binaries/1,copt/1, + bad_utf8_subject/1]). -include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). @@ -45,7 +46,8 @@ all() -> pcre_compile_workspace_overflow, re_infinite_loop, re_backwards_accented, opt_dupnames, opt_all_names, inspect, opt_no_start_optimize,opt_never_utf,opt_ucp, - match_limit, sub_binaries, re_version]. + match_limit, sub_binaries, re_version, + bad_utf8_subject]. groups() -> []. @@ -904,3 +906,54 @@ sub_binaries(Config) when is_list(Config) -> {match,[D]}=re:run(Bin,"a(.+)$",[{capture,[1],binary}]), 4096 = binary:referenced_byte_size(D), ok. + +bad_utf8_subject(Config) when is_list(Config) -> + %% OTP-16553: re:run() did not badarg + %% if both pattern and subject was binaries + %% even though subject contained illegal + %% utf8... + + nomatch = re:run(<<255,255,255>>, <<"a">>, []), + nomatch = re:run(<<255,255,255>>, "a", []), + nomatch = re:run(<<"aaa">>, <<255>>, []), + nomatch = re:run(<<"aaa">>, [255], []), + {match,[{0,1}]} = re:run(<<255,255,255>>, <<255>>, []), + {match,[{0,1}]} = re:run(<<255,255,255>>, [255], []), + %% Badarg on illegal utf8 in subject as of OTP 23... + try + re:run(<<255,255,255>>, <<"a">>, [unicode]), + error(unexpected) + catch + error:badarg -> + ok + end, + try + re:run(<<255,255,255>>, "a", [unicode]), + error(unexpected) + catch + error:badarg -> + ok + end, + try + re:run(<<"aaa">>, <<255>>, [unicode]), + error(unexpected) + catch + error:badarg -> + ok + end, + nomatch = re:run(<<"aaa">>, [255], [unicode]), + try + re:run(<<255,255,255>>, <<255>>, [unicode]), + error(unexpected) + catch + error:badarg -> + ok + end, + try + re:run(<<255,255,255>>, [255], [unicode]), + error(unexpected) + catch + error:badarg -> + ok + end. + diff --git a/lib/stdlib/test/tar_SUITE.erl b/lib/stdlib/test/tar_SUITE.erl index 32a33283d1..fb2b7dc45d 100644 --- a/lib/stdlib/test/tar_SUITE.erl +++ b/lib/stdlib/test/tar_SUITE.erl @@ -578,19 +578,22 @@ extract_from_open_file(Config) when is_list(Config) -> symlinks(Config) when is_list(Config) -> PrivDir = proplists:get_value(priv_dir, Config), Dir = filename:join(PrivDir, "symlinks"), + VulnerableDir = filename:join(PrivDir, "vulnerable_symlinks"), ok = file:make_dir(Dir), + ok = file:make_dir(VulnerableDir), ABadSymlink = filename:join(Dir, "bad_symlink"), - PointsTo = "/a/definitely/non_existing/path", - Res = case make_symlink("/a/definitely/non_existing/path", ABadSymlink) of + PointsTo = "a/definitely/non_existing/path", + Res = case make_symlink("a/definitely/non_existing/path", ABadSymlink) of {error, enotsup} -> {skip, "Symbolic links not supported on this platform"}; ok -> symlinks(Dir, "bad_symlink", PointsTo), - long_symlink(Dir) + long_symlink(Dir), + symlink_vulnerability(VulnerableDir) end, %% Clean up. - delete_files([Dir]), + delete_files([Dir,VulnerableDir]), verify_ports(Config), Res. @@ -678,7 +681,7 @@ long_symlink(Dir) -> ok = file:set_cwd(Dir), AFile = "long_symlink", - RequiresPAX = "/tmp/aarrghh/this/path/is/far/longer/than/one/hundred/characters/which/is/the/maximum/number/of/characters/allowed", + RequiresPAX = "tmp/aarrghh/this/path/is/far/longer/than/one/hundred/characters/which/is/the/maximum/number/of/characters/allowed", ok = file:make_symlink(RequiresPAX, AFile), ok = erl_tar:create(Tar, [AFile], [verbose]), false = is_ustar(Tar), @@ -690,6 +693,23 @@ long_symlink(Dir) -> {ok, RequiresPAX} = file:read_link(AFile), ok. +symlink_vulnerability(Dir) -> + ok = file:set_cwd(Dir), + ok = file:make_dir("tar"), + ok = file:set_cwd("tar"), + ok = file:make_symlink("..", "link"), + ok = file:write_file("../file", <<>>), + ok = erl_tar:create("../my.tar", ["link","link/file"]), + ok = erl_tar:tt("../my.tar"), + + ok = file:set_cwd(Dir), + delete_files(["file","tar"]), + ok = file:make_dir("tar"), + ok = file:set_cwd("tar"), + {error,{"..",unsafe_symlink}} = erl_tar:extract("../my.tar"), + + ok. + init(Config) when is_list(Config) -> PrivDir = proplists:get_value(priv_dir, Config), ok = file:set_cwd(PrivDir), diff --git a/lib/stdlib/vsn.mk b/lib/stdlib/vsn.mk index 80ec81b832..ad60d1f4c1 100644 --- a/lib/stdlib/vsn.mk +++ b/lib/stdlib/vsn.mk @@ -1 +1 @@ -STDLIB_VSN = 3.8.2 +STDLIB_VSN = 3.8.2.4 diff --git a/lib/syntax_tools/doc/src/notes.xml b/lib/syntax_tools/doc/src/notes.xml index 772f5e6e04..a5eb336bae 100644 --- a/lib/syntax_tools/doc/src/notes.xml +++ b/lib/syntax_tools/doc/src/notes.xml @@ -32,6 +32,22 @@ <p>This document describes the changes made to the Syntax_Tools application.</p> +<section><title>Syntax_Tools 2.1.7.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Add missing calls to <c>erl_syntax:unwrap/1</c>. The + nodes concerned represent names and values of maps and + map types. </p> + <p> + Own Id: OTP-16012 Aux Id: PR-2348 </p> + </item> + </list> + </section> + +</section> + <section><title>Syntax_Tools 2.1.7</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index 1be644c620..09ef0bf7a5 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -2192,11 +2192,11 @@ revert_map_field_assoc(Node) -> -spec map_field_assoc_name(syntaxTree()) -> syntaxTree(). map_field_assoc_name(Node) -> - case Node of + case unwrap(Node) of {map_field_assoc, _, Name, _} -> Name; - _ -> - (data(Node))#map_field_assoc.name + Node1 -> + (data(Node1))#map_field_assoc.name end. @@ -2208,11 +2208,11 @@ map_field_assoc_name(Node) -> -spec map_field_assoc_value(syntaxTree()) -> syntaxTree(). map_field_assoc_value(Node) -> - case Node of + case unwrap(Node) of {map_field_assoc, _, _, Value} -> Value; - _ -> - (data(Node))#map_field_assoc.value + Node1 -> + (data(Node1))#map_field_assoc.value end. @@ -2250,11 +2250,11 @@ revert_map_field_exact(Node) -> -spec map_field_exact_name(syntaxTree()) -> syntaxTree(). map_field_exact_name(Node) -> - case Node of + case unwrap(Node) of {map_field_exact, _, Name, _} -> Name; - _ -> - (data(Node))#map_field_exact.name + Node1 -> + (data(Node1))#map_field_exact.name end. @@ -2266,11 +2266,11 @@ map_field_exact_name(Node) -> -spec map_field_exact_value(syntaxTree()) -> syntaxTree(). map_field_exact_value(Node) -> - case Node of + case unwrap(Node) of {map_field_exact, _, _, Value} -> Value; - _ -> - (data(Node))#map_field_exact.value + Node1 -> + (data(Node1))#map_field_exact.value end. @@ -5339,11 +5339,11 @@ revert_map_type_assoc(Node) -> -spec map_type_assoc_name(syntaxTree()) -> syntaxTree(). map_type_assoc_name(Node) -> - case Node of + case unwrap(Node) of {type, _, map_field_assoc, [Name, _]} -> Name; - _ -> - (data(Node))#map_type_assoc.name + Node1 -> + (data(Node1))#map_type_assoc.name end. @@ -5355,11 +5355,11 @@ map_type_assoc_name(Node) -> -spec map_type_assoc_value(syntaxTree()) -> syntaxTree(). map_type_assoc_value(Node) -> - case Node of + case unwrap(Node) of {type, _, map_field_assoc, [_, Value]} -> Value; - _ -> - (data(Node))#map_type_assoc.value + Node1 -> + (data(Node1))#map_type_assoc.value end. @@ -5397,11 +5397,11 @@ revert_map_type_exact(Node) -> -spec map_type_exact_name(syntaxTree()) -> syntaxTree(). map_type_exact_name(Node) -> - case Node of + case unwrap(Node) of {type, _, map_field_exact, [Name, _]} -> Name; - _ -> - (data(Node))#map_type_exact.name + Node1 -> + (data(Node1))#map_type_exact.name end. @@ -5413,11 +5413,11 @@ map_type_exact_name(Node) -> -spec map_type_exact_value(syntaxTree()) -> syntaxTree(). map_type_exact_value(Node) -> - case Node of + case unwrap(Node) of {type, _, map_field_exact, [_, Value]} -> Value; - _ -> - (data(Node))#map_type_exact.value + Node1 -> + (data(Node1))#map_type_exact.value end. diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl index 6b42f7a0a1..6962bc5c5a 100644 --- a/lib/syntax_tools/test/syntax_tools_SUITE.erl +++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl @@ -24,7 +24,7 @@ %% Test cases -export([app_test/1,appup_test/1,smoke_test/1,revert/1,revert_map/1, - revert_map_type/1, + revert_map_type/1,wrapped_subtrees/1, t_abstract_type/1,t_erl_parse_type/1,t_type/1, t_epp_dodger/1, t_comment_scan/1,t_igor/1,t_erl_tidy/1,t_prettypr/1]). @@ -32,6 +32,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [app_test,appup_test,smoke_test,revert,revert_map,revert_map_type, + wrapped_subtrees, t_abstract_type,t_erl_parse_type,t_type,t_epp_dodger, t_comment_scan,t_igor,t_erl_tidy,t_prettypr]. @@ -143,6 +144,41 @@ revert_map_type(Config) when is_list(Config) -> Form2 = erl_syntax:revert(Mapped2), ?t:timetrap_cancel(Dog). +%% Read with erl_parse, wrap each tree node with erl_syntax and check that +%% erl_syntax:subtrees can access the wrapped node. +wrapped_subtrees(Config) when is_list(Config) -> + Dog = ?t:timetrap(?t:minutes(2)), + Wc = filename:join([code:lib_dir(stdlib),"src","*.erl"]), + Fs = filelib:wildcard(Wc) ++ test_files(Config), + Path = [filename:join(code:lib_dir(stdlib), "include"), + filename:join(code:lib_dir(kernel), "include")], + io:format("~p files\n", [length(Fs)]), + Map = fun (File) -> wrapped_subtrees_file(File, Path) end, + case p_run(Map, Fs) of + 0 -> ok; + N -> ?t:fail({N,errors}) + end, + ?t:timetrap_cancel(Dog). + +wrapped_subtrees_file(File, Path) -> + case epp:parse_file(File, Path, []) of + {ok,Fs0} -> + lists:foreach(fun wrap_each/1, Fs0) + end. + +wrap_each(Tree) -> + % only `wrap` top-level erl_parse node + Tree1 = erl_syntax:set_pos(Tree, erl_syntax:get_pos(Tree)), + % assert ability to access subtrees of wrapped node with erl_syntax:subtrees/1 + case erl_syntax:subtrees(Tree1) of + [] -> ok; + List -> + GrpsF = fun(Group) -> + lists:foreach(fun wrap_each/1, Group) + end, + lists:foreach(GrpsF, List) + end. + %% api tests t_type(Config) when is_list(Config) -> diff --git a/lib/syntax_tools/test/syntax_tools_SUITE_data/type_specs.erl b/lib/syntax_tools/test/syntax_tools_SUITE_data/type_specs.erl index e4f8a1c3de..b23acdb39e 100644 --- a/lib/syntax_tools/test/syntax_tools_SUITE_data/type_specs.erl +++ b/lib/syntax_tools/test/syntax_tools_SUITE_data/type_specs.erl @@ -37,6 +37,9 @@ -record(par, {a :: undefined | ?MODULE}). +-record(mt, {e :: #{any() := any()}, + a :: #{any() => any()}}). + -record(r0, {}). -record(r, diff --git a/lib/syntax_tools/vsn.mk b/lib/syntax_tools/vsn.mk index 538c71dc24..3f8af6e0c0 100644 --- a/lib/syntax_tools/vsn.mk +++ b/lib/syntax_tools/vsn.mk @@ -1 +1 @@ -SYNTAX_TOOLS_VSN = 2.1.7 +SYNTAX_TOOLS_VSN = 2.1.7.1 diff --git a/lib/tools/doc/src/notes.xml b/lib/tools/doc/src/notes.xml index 28f8346a19..faae48f72d 100644 --- a/lib/tools/doc/src/notes.xml +++ b/lib/tools/doc/src/notes.xml @@ -31,6 +31,21 @@ </header> <p>This document describes the changes made to the Tools application.</p> +<section><title>Tools 3.1.0.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p><c>cover</c> would fail to start if two processes + tried to start it at the exact same time.</p> + <p> + Own Id: OTP-15813 Aux Id: ERL-943 </p> + </item> + </list> + </section> + +</section> + <section><title>Tools 3.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index 8d4561ca9e..62be773fcf 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -169,6 +169,8 @@ start() -> receive {?SERVER,started} -> {ok,Pid}; + {?SERVER,{error,Error}} -> + {error,Error}; {'DOWN', Ref, _Type, _Object, Info} -> {error,Info} end, @@ -630,21 +632,33 @@ remote_reply(MainNode,Reply) -> %%%---------------------------------------------------------------------- init_main(Starter) -> - register(?SERVER,self()), - %% Having write concurrancy here gives a 40% performance boost - %% when collect/1 is called. - ?COVER_TABLE = ets:new(?COVER_TABLE, [set, public, named_table, - {write_concurrency, true}]), - ?COVER_CLAUSE_TABLE = ets:new(?COVER_CLAUSE_TABLE, [set, public, + try register(?SERVER,self()) of + true -> + %% Having write concurrancy here gives a 40% performance boost + %% when collect/1 is called. + ?COVER_TABLE = ets:new(?COVER_TABLE, [set, public, named_table, + {write_concurrency, true}]), + ?COVER_CLAUSE_TABLE = ets:new(?COVER_CLAUSE_TABLE, [set, public, + named_table]), + ?BINARY_TABLE = ets:new(?BINARY_TABLE, [set, public, named_table]), + ?COLLECTION_TABLE = ets:new(?COLLECTION_TABLE, [set, public, named_table]), - ?BINARY_TABLE = ets:new(?BINARY_TABLE, [set, public, named_table]), - ?COLLECTION_TABLE = ets:new(?COLLECTION_TABLE, [set, public, - named_table]), - ?COLLECTION_CLAUSE_TABLE = ets:new(?COLLECTION_CLAUSE_TABLE, [set, public, - named_table]), - ok = net_kernel:monitor_nodes(true), - Starter ! {?SERVER,started}, - main_process_loop(#main_state{}). + ?COLLECTION_CLAUSE_TABLE = ets:new(?COLLECTION_CLAUSE_TABLE, + [set, public, named_table]), + ok = net_kernel:monitor_nodes(true), + Starter ! {?SERVER,started}, + main_process_loop(#main_state{}) + catch + error:badarg -> + %% The server's already registered; either report that it's already + %% started or try again if it died before we could find its pid. + case whereis(?SERVER) of + undefined -> + init_main(Starter); + Pid -> + Starter ! {?SERVER, {error, {already_started, Pid}}} + end + end. main_process_loop(State) -> receive diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index 161b0105b9..806297abdd 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -35,7 +35,8 @@ all() -> distribution, reconnect, die_and_reconnect, dont_reconnect_after_stop, stop_node_after_disconnect, export_import, otp_5031, otp_6115, - otp_8270, otp_10979_hanging_node, otp_14817], + otp_8270, otp_10979_hanging_node, otp_14817, + startup_race], case whereis(cover_server) of undefined -> [coverage,StartStop ++ NoStartStop]; @@ -1742,6 +1743,32 @@ otp_13289(Config) -> ok = file:delete(File), ok. +%% ERL-943; We should not crash on startup when multiple servers race to +%% register the server name. +startup_race(Config) when is_list(Config) -> + PidRefs = [spawn_monitor(fun() -> + case cover:start() of + {error, {already_started, _Pid}} -> + ok; + {ok, _Pid} -> + ok + end + end) || _<- lists:seq(1,8)], + startup_race_1(PidRefs). + +startup_race_1([{Pid, Ref} | PidRefs]) -> + receive + {'DOWN', Ref, process, Pid, normal} -> + startup_race_1(PidRefs); + {'DOWN', Ref, process, Pid, _Other} -> + ct:fail("Cover server crashed on startup.") + after 5000 -> + ct:fail("Timed out.") + end; +startup_race_1([]) -> + cover:stop(), + ok. + %%--Auxiliary------------------------------------------------------------ analyse_expr(Expr, Config) -> diff --git a/lib/tools/vsn.mk b/lib/tools/vsn.mk index 5700885549..77e2b8e00f 100644 --- a/lib/tools/vsn.mk +++ b/lib/tools/vsn.mk @@ -1 +1 @@ -TOOLS_VSN = 3.1 +TOOLS_VSN = 3.1.0.1 diff --git a/lib/xmerl/doc/src/notes.xml b/lib/xmerl/doc/src/notes.xml index d6b6dfdfb5..63070ea316 100644 --- a/lib/xmerl/doc/src/notes.xml +++ b/lib/xmerl/doc/src/notes.xml @@ -32,6 +32,23 @@ <p>This document describes the changes made to the Xmerl application.</p> +<section><title>Xmerl 1.3.20.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + <c>xmerl_sax_parser</c> crashed during charset detection + when the xml declarations attribute values was missing + the closing quotation (' or ").</p> + <p> + Own Id: OTP-15826</p> + </item> + </list> + </section> + +</section> + <section><title>Xmerl 1.3.20</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/xmerl/src/xmerl_sax_parser.erl b/lib/xmerl/src/xmerl_sax_parser.erl index fe836fd8cd..2767d02552 100644 --- a/lib/xmerl/src/xmerl_sax_parser.erl +++ b/lib/xmerl/src/xmerl_sax_parser.erl @@ -369,8 +369,8 @@ parse_eq(_, State) -> %%---------------------------------------------------------------------- parse_value(<<C, Rest/binary>>, State) when ?is_whitespace(C) -> parse_value(Rest, State); -parse_value(<<C, Rest/binary>>, _State) when C == $'; C == $" -> - parse_value_1(Rest, C, []); +parse_value(<<C, Rest/binary>>, State) when C == $'; C == $" -> + parse_value_1(Rest, C, [], State); parse_value(_, State) -> ?fatal_error(State, "\', \" or whitespace expected"). @@ -383,10 +383,12 @@ parse_value(_, State) -> %% Rest = binary() %% Description: Parsing an attribute value from the stream. %%---------------------------------------------------------------------- -parse_value_1(<<Stop, Rest/binary>>, Stop, Acc) -> +parse_value_1(<<Stop, Rest/binary>>, Stop, Acc, _State) -> {lists:reverse(Acc), Rest}; -parse_value_1(<<C, Rest/binary>>, Stop, Acc) -> - parse_value_1(Rest, Stop, [C |Acc]). +parse_value_1(<<C, Rest/binary>>, Stop, Acc, State) -> + parse_value_1(Rest, Stop, [C |Acc], State); +parse_value_1(_, _Stop, _Acc, State) -> + ?fatal_error(State, "end of input and no \' or \" found"). %%====================================================================== %% Default functions diff --git a/lib/xmerl/vsn.mk b/lib/xmerl/vsn.mk index 31ffa6e749..3c97615e1e 100644 --- a/lib/xmerl/vsn.mk +++ b/lib/xmerl/vsn.mk @@ -1 +1 @@ -XMERL_VSN = 1.3.20 +XMERL_VSN = 1.3.20.1 diff --git a/make/otp_version_tickets b/make/otp_version_tickets index bf32816fb2..6141ea02ad 100644 --- a/make/otp_version_tickets +++ b/make/otp_version_tickets @@ -1,8 +1,6 @@ -OTP-14746 -OTP-15295 -OTP-15717 -OTP-15758 -OTP-15781 -OTP-15785 -OTP-15793 -OTP-15802 +OTP-16607 +OTP-16930 +OTP-17291 +OTP-17307 +OTP-17349 +OTP-17358 diff --git a/otp_versions.table b/otp_versions.table index 8f885e13fb..07b38e47ba 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,26 @@ +OTP-21.3.8.23 : erl_interface-3.11.3.2 erts-10.3.5.18 runtime_tools-1.13.2.1 # asn1-5.0.8 common_test-1.17.2.1 compiler-7.3.2 crypto-4.4.2.3 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 et-1.6.4 eunit-2.3.7 ftp-1.0.2.2 hipe-3.18.3 inets-7.0.7.2 jinterface-1.9.1 kernel-6.3.1.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6.1 reltool-0.7.8 sasl-3.3 snmp-5.2.12 ssh-4.7.6.6 ssl-9.2.3.7 stdlib-3.8.2.4 syntax_tools-2.1.7.1 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.22 : erts-10.3.5.17 ssh-4.7.6.6 # asn1-5.0.8 common_test-1.17.2.1 compiler-7.3.2 crypto-4.4.2.3 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3.1 et-1.6.4 eunit-2.3.7 ftp-1.0.2.2 hipe-3.18.3 inets-7.0.7.2 jinterface-1.9.1 kernel-6.3.1.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6.1 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssl-9.2.3.7 stdlib-3.8.2.4 syntax_tools-2.1.7.1 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.21 : erts-10.3.5.16 # asn1-5.0.8 common_test-1.17.2.1 compiler-7.3.2 crypto-4.4.2.3 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3.1 et-1.6.4 eunit-2.3.7 ftp-1.0.2.2 hipe-3.18.3 inets-7.0.7.2 jinterface-1.9.1 kernel-6.3.1.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6.1 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.6.5 ssl-9.2.3.7 stdlib-3.8.2.4 syntax_tools-2.1.7.1 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.20 : erl_interface-3.11.3.1 # asn1-5.0.8 common_test-1.17.2.1 compiler-7.3.2 crypto-4.4.2.3 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erts-10.3.5.15 et-1.6.4 eunit-2.3.7 ftp-1.0.2.2 hipe-3.18.3 inets-7.0.7.2 jinterface-1.9.1 kernel-6.3.1.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6.1 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.6.5 ssl-9.2.3.7 stdlib-3.8.2.4 syntax_tools-2.1.7.1 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.19 : crypto-4.4.2.3 erts-10.3.5.15 # asn1-5.0.8 common_test-1.17.2.1 compiler-7.3.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3 et-1.6.4 eunit-2.3.7 ftp-1.0.2.2 hipe-3.18.3 inets-7.0.7.2 jinterface-1.9.1 kernel-6.3.1.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6.1 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.6.5 ssl-9.2.3.7 stdlib-3.8.2.4 syntax_tools-2.1.7.1 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.18 : erts-10.3.5.14 ssh-4.7.6.5 # asn1-5.0.8 common_test-1.17.2.1 compiler-7.3.2 crypto-4.4.2.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3 et-1.6.4 eunit-2.3.7 ftp-1.0.2.2 hipe-3.18.3 inets-7.0.7.2 jinterface-1.9.1 kernel-6.3.1.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6.1 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssl-9.2.3.7 stdlib-3.8.2.4 syntax_tools-2.1.7.1 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.17 : erts-10.3.5.13 ssl-9.2.3.7 # asn1-5.0.8 common_test-1.17.2.1 compiler-7.3.2 crypto-4.4.2.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3 et-1.6.4 eunit-2.3.7 ftp-1.0.2.2 hipe-3.18.3 inets-7.0.7.2 jinterface-1.9.1 kernel-6.3.1.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6.1 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.6.4 stdlib-3.8.2.4 syntax_tools-2.1.7.1 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.16 : erts-10.3.5.12 # asn1-5.0.8 common_test-1.17.2.1 compiler-7.3.2 crypto-4.4.2.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3 et-1.6.4 eunit-2.3.7 ftp-1.0.2.2 hipe-3.18.3 inets-7.0.7.2 jinterface-1.9.1 kernel-6.3.1.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6.1 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.6.4 ssl-9.2.3.6 stdlib-3.8.2.4 syntax_tools-2.1.7.1 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.15 : erts-10.3.5.11 ssh-4.7.6.4 ssl-9.2.3.6 stdlib-3.8.2.4 # asn1-5.0.8 common_test-1.17.2.1 compiler-7.3.2 crypto-4.4.2.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3 et-1.6.4 eunit-2.3.7 ftp-1.0.2.2 hipe-3.18.3 inets-7.0.7.2 jinterface-1.9.1 kernel-6.3.1.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6.1 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 syntax_tools-2.1.7.1 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.14 : erts-10.3.5.10 # asn1-5.0.8 common_test-1.17.2.1 compiler-7.3.2 crypto-4.4.2.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3 et-1.6.4 eunit-2.3.7 ftp-1.0.2.2 hipe-3.18.3 inets-7.0.7.2 jinterface-1.9.1 kernel-6.3.1.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6.1 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.6.3 ssl-9.2.3.5 stdlib-3.8.2.3 syntax_tools-2.1.7.1 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.13 : erts-10.3.5.9 stdlib-3.8.2.3 # asn1-5.0.8 common_test-1.17.2.1 compiler-7.3.2 crypto-4.4.2.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3 et-1.6.4 eunit-2.3.7 ftp-1.0.2.2 hipe-3.18.3 inets-7.0.7.2 jinterface-1.9.1 kernel-6.3.1.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6.1 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.6.3 ssl-9.2.3.5 syntax_tools-2.1.7.1 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.12 : crypto-4.4.2.2 erts-10.3.5.8 ssh-4.7.6.3 # asn1-5.0.8 common_test-1.17.2.1 compiler-7.3.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3 et-1.6.4 eunit-2.3.7 ftp-1.0.2.2 hipe-3.18.3 inets-7.0.7.2 jinterface-1.9.1 kernel-6.3.1.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6.1 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssl-9.2.3.5 stdlib-3.8.2.2 syntax_tools-2.1.7.1 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.11 : erts-10.3.5.7 ftp-1.0.2.2 # asn1-5.0.8 common_test-1.17.2.1 compiler-7.3.2 crypto-4.4.2.1 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3 et-1.6.4 eunit-2.3.7 hipe-3.18.3 inets-7.0.7.2 jinterface-1.9.1 kernel-6.3.1.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6.1 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.6.2 ssl-9.2.3.5 stdlib-3.8.2.2 syntax_tools-2.1.7.1 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.10 : ftp-1.0.2.1 ssh-4.7.6.2 # asn1-5.0.8 common_test-1.17.2.1 compiler-7.3.2 crypto-4.4.2.1 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3 erts-10.3.5.6 et-1.6.4 eunit-2.3.7 hipe-3.18.3 inets-7.0.7.2 jinterface-1.9.1 kernel-6.3.1.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6.1 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssl-9.2.3.5 stdlib-3.8.2.2 syntax_tools-2.1.7.1 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.9 : inets-7.0.7.2 # asn1-5.0.8 common_test-1.17.2.1 compiler-7.3.2 crypto-4.4.2.1 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3 erts-10.3.5.6 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 jinterface-1.9.1 kernel-6.3.1.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6.1 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.6.1 ssl-9.2.3.5 stdlib-3.8.2.2 syntax_tools-2.1.7.1 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.8 : crypto-4.4.2.1 erts-10.3.5.6 # asn1-5.0.8 common_test-1.17.2.1 compiler-7.3.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.7.1 jinterface-1.9.1 kernel-6.3.1.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6.1 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.6.1 ssl-9.2.3.5 stdlib-3.8.2.2 syntax_tools-2.1.7.1 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.7 : erts-10.3.5.5 inets-7.0.7.1 kernel-6.3.1.3 ssh-4.7.6.1 syntax_tools-2.1.7.1 # asn1-5.0.8 common_test-1.17.2.1 compiler-7.3.2 crypto-4.4.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 jinterface-1.9.1 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6.1 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssl-9.2.3.5 stdlib-3.8.2.2 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.6 : ssl-9.2.3.5 # asn1-5.0.8 common_test-1.17.2.1 compiler-7.3.2 crypto-4.4.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3 erts-10.3.5.4 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.7 jinterface-1.9.1 kernel-6.3.1.2 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6.1 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.6 stdlib-3.8.2.2 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.5 : erts-10.3.5.4 ssl-9.2.3.4 # asn1-5.0.8 common_test-1.17.2.1 compiler-7.3.2 crypto-4.4.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.7 jinterface-1.9.1 kernel-6.3.1.2 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6.1 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.6 stdlib-3.8.2.2 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.4 : common_test-1.17.2.1 erts-10.3.5.3 kernel-6.3.1.2 public_key-1.6.6.1 ssl-9.2.3.3 stdlib-3.8.2.2 # asn1-5.0.8 compiler-7.3.2 crypto-4.4.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.7 jinterface-1.9.1 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.6 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.3 : erts-10.3.5.2 kernel-6.3.1.1 ssl-9.2.3.2 stdlib-3.8.2.1 # asn1-5.0.8 common_test-1.17.2 compiler-7.3.2 crypto-4.4.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.7 jinterface-1.9.1 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.6 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 xmerl-1.3.20.1 : +OTP-21.3.8.2 : xmerl-1.3.20.1 # asn1-5.0.8 common_test-1.17.2 compiler-7.3.2 crypto-4.4.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3 erts-10.3.5.1 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.7 jinterface-1.9.1 kernel-6.3.1 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.6 ssl-9.2.3.1 stdlib-3.8.2 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1.0.1 wx-1.8.7 : +OTP-21.3.8.1 : erts-10.3.5.1 ssl-9.2.3.1 tools-3.1.0.1 # asn1-5.0.8 common_test-1.17.2 compiler-7.3.2 crypto-4.4.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.7 erl_docgen-0.9 erl_interface-3.11.3 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.7 jinterface-1.9.1 kernel-6.3.1 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.6 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.6 stdlib-3.8.2 syntax_tools-2.1.7 tftp-1.0.1 wx-1.8.7 xmerl-1.3.20 : OTP-21.3.8 : common_test-1.17.2 eldap-1.2.7 erl_interface-3.11.3 erts-10.3.5 public_key-1.6.6 ssl-9.2.3 stdlib-3.8.2 # asn1-5.0.8 compiler-7.3.2 crypto-4.4.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 erl_docgen-0.9 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.7 jinterface-1.9.1 kernel-6.3.1 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.6 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1 wx-1.8.7 xmerl-1.3.20 : OTP-21.3.7 : ssh-4.7.6 # asn1-5.0.8 common_test-1.17.1 compiler-7.3.2 crypto-4.4.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.6 erl_docgen-0.9 erl_interface-3.11.2 erts-10.3.4 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.7 jinterface-1.9.1 kernel-6.3.1 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.5 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssl-9.2.2 stdlib-3.8.1 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1 wx-1.8.7 xmerl-1.3.20 : OTP-21.3.6 : ssl-9.2.2 # asn1-5.0.8 common_test-1.17.1 compiler-7.3.2 crypto-4.4.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.6 erl_docgen-0.9 erl_interface-3.11.2 erts-10.3.4 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.7 jinterface-1.9.1 kernel-6.3.1 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.5 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.5 stdlib-3.8.1 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1 wx-1.8.7 xmerl-1.3.20 : diff --git a/scripts/build-otp-tar b/scripts/build-otp-tar new file mode 100755 index 0000000000..fa7ad2c19d --- /dev/null +++ b/scripts/build-otp-tar @@ -0,0 +1,701 @@ +#!/bin/bash + +# +# Description: +# Create one gzipped-tar file containing pre-built platform independent +# OTP code and one gzipped-tar file containing clean source code. +# Author: Rickard Green +# + +Revision=X +revision="$Revision: 1.8 $Revision" +version=`echo $revision | sed "s|[^0-9]*\([0-9.]*\).*|\1|g"` + +# 'global_restore' contains files and/or directories that always +# should be restored to source state (@TARGET@ will be replaced +# by actual target name). +global_restore="@TARGET@ config.status config.log core core.*" + +prebuilt_filename=prebuilt.files +#configure_args="--disable-smp-support --disable-hybrid-heap" +configure_args="--disable-hybrid-heap" +pbskip_name=prebuild.skip +pbdel_name=prebuild.delete +skip_name=SKIP +script_name=`basename $0` +verbose=true +work_dir_used=false +remove_work_dir=false +failing=false +got_warning=false +rm=/bin/rm +gtar=tar +tmp_dir=/tmp +build_log= +work_dir= +build_dir= +cln_tgz=SRC_CLN.tar.gz +bld_tgz=SRC_PREBLD.tar.gz +src_tgz= +newfiles_log= +work_dir= +tmp_work_dir= + +print_usage () { + echo "Usage: +$script_name +[-b|--build-dir <directory>] +[-d|--deleted-files-log <filename>] +[-g|--gtar <gtar>] +[-h|--help] +[-l|--build-log <filename>] +[-n|--new-files-log <filename>] +[-o|--output-filenames <clean source filename> <pre-build filename>] +[-r|--remove-working-dir] +[-s|--silent] +[-v|--version] +[-w|--working-dir <existing directory>] +<source filename>" +} + +print_help () { + echo "--- otp_prebuild version $version -------------------------------------------" + echo `print_usage` + echo "" + echo " Mandatory parameters:" + echo " <source filename> --- Filename of gzipped tar" + echo " file containing the OTP" + echo " source (produced by the" + echo " otp_pack script)" + echo "" + echo " Optional parameters:" + echo " -b|--build-dir <directory> --- Directory containing" + echo " a build from exactly the" + echo " same source as specified" + echo " by the mandatory" + echo " parameter. If this" + echo " parameter isn't given," + echo " OTP will be built." + echo " -d|--deleted-files-log <filename> --- Filename of file to log" + echo " deleted files to" + echo " (deleted files in the" + echo " pre-build source result" + echo " compared to the clean" + echo " source result)." + echo " Defaults to /dev/null." + echo " -g|--gtar <gtar> --- GNU tar to use. Defaults" + echo " to 'tar' in path." + echo " -h|--help --- Display (this) help" + echo " text and exit." + echo " -l|--build-log <filename> --- Filename of file to log" + echo " OTP build results to." + echo " Defaults to /dev/null." + echo " -n|--new-files-log <filename> --- Filename of file to log" + echo " new files to (new files" + echo " in the pre-build source" + echo " result compared to the" + echo " clean source result)." + echo " Defaults to /dev/null." + echo " -o|--output-filenames <clean source filename> <pre-build filename>" + echo " --- Filename of clean source" + echo " result and filename of" + echo " pre-build source result." + echo " Both as gzipped tar " + echo " files. Defaults to " + echo " 'SRC_CLN.tar.gz', resp." + echo " 'SRC_PREBLD.tar.gz'." + echo " -r|--remove-working-dir --- Remove content of" + echo " used, existing working" + echo " directory (passed with" + echo " the -w parameter) when" + echo " done." + echo " -s|--silent --- Silent mode." + echo " -v|--version --- Print version and exit." + echo " -w|--working-dir <existing directory> --- An existing working" + echo " directory to use." + echo " If not passed, a" + echo " temporary working" + echo " directory will be" + echo " created, used, and then" + echo " removed." + echo "" + echo "--- otp_prebuild version $version -------------------------------------------" +} + +progress_start () { + if [ $verbose = true ]; then + printf "${script_name}: $@..." + fi +} + +progress () { + if [ $verbose = true ]; then + if [ $got_warning = true ]; then + got_warning=false + else + if [ $failing = false ]; then + printf " ok\n" + fi + fi + printf "${script_name}: $@..." + fi +} + +progress_end () { + if [ $verbose = true ]; then + if [ $got_warning = true ]; then + got_warning=false + else + if [ $failing = false ]; then + printf " ok\n" + fi + fi + printf "${script_name}: done\n" + fi +} + +remove () { + # + # As an extra safety precaution, 'remove' requires the path of + # the file or directory to be removed to begin with $work_dir. + # + if [ "X${work_dir}" = "X" ]; then + error "remove() called before working dir has been initialized" + fi + while [ $# -gt 0 ]; do + case "X$1" in + X${work_dir}*) + ;; + *) + error "Refusing to remove $1 since its path doesn't begin with working directory (${work_dir})";; + esac + $rm -rf $1 + if [ $? -ne 0 ]; then + error "Failed to remove $1" + fi + shift + done +} + +cleanup_work_dir () { + if [ "x$tmp_work_dir" != "x" ]; then + # + # Temporary working directories should always be removed + # + if [ $work_dir_used = true ]; then + progress "Removing temporary working directory" + if [ "x$work_dir" != "x" ]; then + $rm -rf $work_dir + fi + fi + else + if [ $remove_work_dir != false -a $work_dir_used != false ]; then + progress "Removing content of working directory" + if [ "x$work_dir" != "x" ]; then + $rm -rf $work_dir/* + fi + fi + fi +} + +error () { + failing=true + echo "" 1>&2 + echo "ERROR: $@" 1>&2 + echo `cleanup_work_dir` 1>&2 + echo "" 1>&2 + exit 1 +} + +warning () { + got_warning=true + echo " WARNING: $@" +} + +usage_error () { + failing=true + echo "" 1>&2 + echo "ERROR: $@" 1>&2 + echo `print_usage` 1>&2 + echo `cleanup_work_dir` 1>&2 + echo "" 1>&2 + exit 1 +} + +missing_param_value () { + failing=true + echo "" 1>&2 + echo "Missing value(s) to parameter $1" 1>&2 + echo `print_usage` 1>&2 + echo `cleanup_work_dir` 1>&2 + echo "" 1>&2 + exit 1 +} + +valid_values () { + while [ $# -gt 0 ]; do + case $1 in + -*) return 1;; + *) ;; + esac + shift + done + return 0 +} + +copy () { + if [ $# -ne 2 ]; then + error "copy: bad number of arguments: $#" + fi + local from_dir=`dirname $1` + local from_obj=`basename $1` + local to_dir=$2 + gtar_err=`(( $gtar -c -C $from_dir -f - $from_obj || echo ERROR 1>&2 ) | ( $gtar -x -B -p -C $to_dir -f - || echo ERROR 1>&2 )) 2>&1` + if [ "x$gtar_err" != "x" ]; then + echo "$gtar_err" + error "Failed to copy $1 to $2" + fi +} + +restore () { + if [ $# -ne 1 ]; then + error "restore: bad number of arguments: $#"; + fi + + local obj=$1 + local src_exist=false + local obj_type= + + if [ -d $prebld_root/$obj ]; then + if [ -d $src_root/$obj ]; then + src_exist=true; + fi + obj_type="directory" + else + if [ -f $src_root/$obj ]; then + src_exist=true; + fi + obj_type="file" + fi + + progress "Removing $obj_type $obj from pre-build-directory" + remove $prebld_root/$obj + + if [ $src_exist = true ]; then + progress "Copying $obj_type $obj from source-directory to pre-build-directory" + copy $src_root/$obj $prebld_root/`dirname $obj` + fi +} + +check_filename () { # <file containing file name> <dir> <filename> + if [ $# -ne 3 ]; then + error "check_filename: bad number of arguments: $#" + fi + case $3 in + /*|../*|*/../*|*/..|*/./*|*/.) + error "File path not allowed ($3) in: $1";; + .) + echo "$2";; + *) + echo "$2/$3";; + esac +} + +start_dir=`pwd` +if [ ! -d $tmp_dir ]; then + $tmp_dir=$start_dir +fi + +while [ $# -gt 0 ]; do + case $1 in + -b|--build-dir) + (test $# -gt 1 && valid_values $2) || missing_param_value $1 + shift + build_dir=$1;; + -d|--deleted-files-log) + (test $# -gt 1 && valid_values $2) || missing_param_value $1 + shift + deletedfiles_log=$1;; + -g|--gtar) + (test $# -gt 1 && valid_values $2) || missing_param_value $1 + shift + gtar=$1;; + -h|--help) + print_help + exit 0;; + -l|--build-log) + (test $# -gt 1 && valid_values $2) || missing_param_value $1 + shift + build_log=$1;; + -n|--new-files-log) + (test $# -gt 1 && valid_values $2) || missing_param_value $1 + shift + newfiles_log=$1;; + -o|--output-filenames) + (test $# -gt 2 && valid_values $2 $3) || missing_param_value $1 + shift + cln_tgz=$1 + shift + bld_tgz=$1;; + -r|--remove-working-dir) + remove_work_dir=true;; + -s|--silent) + verbose=false;; + -v|--version) + echo "otp_prebuild version $version" + exit 0;; + -w|--working-dir) + (test $# -gt 1 && valid_values $2) || missing_param_value $1 + shift + work_dir=$1;; + -*) + usage_error "Unknown argument: $1";; + *) + if [ "x$src_tgz" != "x" ]; then + usage_error "Multiple source filnames: $src_tgz; $1" + fi + src_tgz=$1;; + esac + shift +done + + +progress_start "Verifying arguments" + +case "x$bld_tgz" in + x) + usage_error "Argument -o|--output-filenames missing";; + x/*) + ;; + *) + bld_tgz=$start_dir/$bld_tgz;; +esac + +case "x$cln_tgz" in + x) + usage_error "Argument -o|--output-filenames missing";; + x/*) + ;; + *) + cln_tgz=$start_dir/$cln_tgz;; +esac + +case "x$build_log" in + x) ;; + x/*) + ;; + *) + build_log=$start_dir/$build_log;; +esac + +case "x$src_tgz" in + x) + usage_error "Mandatory argument <source filename> missing";; + x/*) + ;; + *) + src_tgz=$start_dir/$src_tgz;; +esac + + +if [ "x$work_dir" != "x" ]; then + case $work_dir in + /*) ;; + *) work_dir=$start_dir/$work_dir;; + esac + progress "Using existing working directory: $work_dir" + if [ ! -d $work_dir ]; then + error "Not a directory: $work_dir" + fi +else + tmp_work_dir=$tmp_dir/otp_prebuild.$$ + progress "Creating working directory: $tmp_work_dir" + + mkdir $tmp_work_dir + if [ $? -ne 0 ]; then + error "Failed to create working directory: $tmp_work_dir" + fi + work_dir=$tmp_work_dir + work_dir_used=true +fi + +if [ "x$build_dir" != "x" ]; then + + progress "Using already built OTP distibution in: $build_dir" + +else + + build_root=$work_dir/build + + progress "Creating build-directory: $build_root" + + mkdir $build_root + if [ $? -ne 0 ]; then + error "Failed to build-directory" + fi + + work_dir_used=true + + progress "Unpacking OTP source code into build-directory" + + $gtar -z -x -C $build_root -f $src_tgz + if [ $? -ne 0 ]; then + error "Failed to unpack source" + fi + cd $build_root/* + if [ $? -ne 0 ]; then + error "Failed to change directory into unpacked source" + fi + build_dir=`pwd` + if [ ! -f ./otp_build ]; then + usage_error "Bad build-directory" + fi + + export ERL_TOP=$build_dir + + if [ "x$build_log" = "x" ]; then + build_log=/dev/null + progress "Using $build_log as build log" + else + progress "Creating build log: $build_log" + touch $build_log >/dev/null 2>&1 + if [ $? -ne 0 ]; then + error "Failed to create build log" + fi + fi + + progress "Writing environment to build log" + echo " === Environment ==================================== " >> $build_log + env >> $build_log + + progress "Running autoconf in OTP" + echo " " >> $build_log + echo " === Running autoconf in OTP ================================ " >> $build_log + echo " " >> $build_log + echo "./otp_build autoconf" >> $build_log + ./otp_build autoconf >> $build_log 2>&1 + if [ $? -ne 0 ]; then + error "Failed to run autoconf in OTP" + fi + + progress "Configuring OTP" + echo " " >> $build_log + echo " === Configuring OTP ================================ " >> $build_log + echo " " >> $build_log + echo "./otp_build configure $configure_args" >> $build_log + ./otp_build configure $configure_args >> $build_log 2>&1 + if [ $? -ne 0 ]; then + error "Failed to configure OTP" + fi + + progress "Building OTP" + echo " " >> $build_log + echo " === Building OTP =================================== " >> $build_log + echo " " >> $build_log + echo "./otp_build boot -a" >> $build_log + ./otp_build boot -a >> $build_log 2>&1 + if [ $? -ne 0 ]; then + error "Failed to build OTP" + fi + echo " " >> $build_log + echo " ==================================================== " >> $build_log + + cd $start_dir +fi + +if [ ! -d $build_dir -o ! -f $build_dir/otp_build ]; then + usage_error "Bad build-directory" +fi + +build_dir_name=`basename $build_dir` + +prebld_root=$work_dir/prebuild +progress "Creating pre-build-directory: $prebld_root" +mkdir $prebld_root +if [ $? -ne 0 ]; then + error "Failed to create temporary pack dir" +fi + +work_dir_used=true + +progress "Copying OTP build into pre-build-directory: $prebld_root" +copy $build_dir $prebld_root + +prebld_dir=$prebld_root/$build_dir_name + +src_root=$work_dir/src +progress "Creating source-directory: $src_root" +mkdir $src_root +if [ $? -ne 0 ]; then + error "Failed to source-directory" +fi + +progress "Unpacking OTP source code into source-directory" +$gtar -z -x -C $src_root -f $src_tgz +if [ $? -ne 0 ]; then + error "Failed to unpack source" +fi + +src_dir=$src_root/$build_dir_name +if [ ! -d $src_dir -o ! -f $src_dir/otp_build ]; then + usage_error "Source and build mismatch" +fi + +progress "Checking target directory name" +target_dirname=`$prebld_dir/erts/autoconf/config.guess` +if [ $? -ne 0 ]; then + error "Failed to check target directory name" +fi +if [ "x$target_dirname" = "x" ]; then + error "No target directory name found" +fi + +global_restore=`echo $global_restore | sed "s|@TARGET@|$target_dirname|g"` +if [ $? -ne 0 ]; then + error "Failed to replace @TARGET@ with $target_dirname in global_restore" +fi + +cd $prebld_root +for restore_name in $global_restore; do + progress "Searching for $restore_name files/directories in pre-build-directory" + for restore_obj in `find . -name $restore_name`; do + restore $restore_obj + done +done + +progress "Searching for $skip_name files" +cd $prebld_root +skip_files=`find . -name $skip_name` + +for skip_file in $skip_files; do + # Normally these files should be removed, but if a skip file is part of + # the source it shouldn't be removed. + restore $skip_file +done + +progress "Searching for $pbskip_name files in source-directory" +cd $src_root +skip_files=`find . -name $pbskip_name` + +for skip_file in $skip_files; do + progress "Removing $skip_file from source-directory" + remove $src_root/$skip_file +done + +progress "Searching for $pbdel_name files in source-directory" +cd $src_root +delete_files=`find . -name $pbdel_name` + +for delete_file in $delete_files; do + progress "Removing $delete_file from source-directory" + remove $src_root/$delete_file +done + +progress "Searching for $pbskip_name files in pre-build-directory" +cd $prebld_root +skip_files=`find . -name $pbskip_name` + +for skip_file in $skip_files; do + dir=`dirname $skip_file` + restore_objs=`cat $skip_file` + for rf in $restore_objs; do + restore `check_filename $skip_file $dir $rf` + done + + progress "Removing $skip_file from pre-build-directory" + remove $prebld_root/$skip_file +done + +progress "Searching for $pbdel_name files in pre-build-directory" +cd $prebld_root +delete_files=`find . -name $pbdel_name` + +for delete_file in $delete_files; do + dir=`dirname $delete_file` + delete_objs=`cat $delete_file` + for delete_obj in $delete_objs; do + dobj=`check_filename $delete_file $dir $delete_obj` + progress "Removing $dobj from pre-build-directory" + remove $prebld_root/$dobj + done + + progress "Removing $delete_file from pre-build-directory" + remove $prebld_root/$delete_file +done + +cd $prebld_dir +prebuilt_files=$prebld_dir/$prebuilt_filename +progress "Creating $build_dir_name/$prebuilt_filename in pre-build-directory" +touch $prebuilt_files >/dev/null 2>&1 +if [ $? -ne 0 ]; then + warning "Failed to create $build_dir_name/$prebuilt_filename in pre-build-directory" +fi +progress "Writing prebuilt files to $build_dir_name/$prebuilt_filename in pre-build-directory" +prebld_files=`find . -type f | sort` +for prebld_file in $prebld_files; do + if [ ! -f $src_dir/$prebld_file ]; then + echo "$prebld_file" >> $prebuilt_files + fi +done + +if [ "x$deletedfiles_log" != "x" ]; then + case $deletedfiles_log in + /*) ;; + *) deletedfiles_log=$start_dir/$deletedfiles_log;; + esac + + $rm -f $deletedfiles_log + progress "Creating deleted files log: $deletedfiles_log" + touch $deletedfiles_log >/dev/null 2>&1 + if [ $? -ne 0 ]; then + warning "Failed to create deleted files log" + else + progress "Writing deleted files log" + cd $src_root + src_files=`find . -type f | sort` + for src_file in $src_files; do + if [ ! -f $prebld_root/$src_file ]; then + echo "$src_file" >> $deletedfiles_log + fi + done + fi +fi + +if [ "x$newfiles_log" != "x" ]; then + case $newfiles_log in + /*) ;; + *) newfiles_log=$start_dir/$newfiles_log;; + esac + + $rm -f $newfiles_log + progress "Creating new files log: $newfiles_log" + touch $newfiles_log >/dev/null 2>&1 + if [ $? -ne 0 ]; then + warning "Failed to create new files log" + else + progress "Writing new files log" + cat $prebuilt_files | sed "s|^./|./$build_dir_name/|g" > $newfiles_log + fi +fi + +progress "Packing source-directory into output file: $cln_tgz" +cd $start_root +$rm -f $cln_tgz +$gtar -C $src_root -z -c -f $cln_tgz $build_dir_name +if [ $? -ne 0 ]; then + error "Failed to create tar file: $cln_tgz" +fi + +progress "Packing pre-build-directory into output file: $bld_tgz" +cd $start_root +$rm -f $bld_tgz +$gtar -C $prebld_root -z -c -f $bld_tgz $build_dir_name +if [ $? -ne 0 ]; then + error "Failed to create tar file: $bld_tgz" +fi + +cleanup_work_dir + +progress_end + +exit 0 diff --git a/scripts/bundle-otp b/scripts/bundle-otp index aa1f166732..ce5bc47572 100755 --- a/scripts/bundle-otp +++ b/scripts/bundle-otp @@ -2,14 +2,17 @@ set -e -if [ "$TRAVIS_PULL_REQUEST" = "false" -a "$TRAVIS_REPO_SLUG" != "erlang/otp" ]; then - exit 0 -fi +GIT_TAG="$1" +ERL_TOP=${ERL_TOP:-$PWD} + +OTP_META_FILE=$ERL_TOP/artifacts/${GIT_TAG}.0-bundle.txt +OTP_FILE=$ERL_TOP/artifacts/${GIT_TAG}.0-bundle.tar.gz -OTP_META_FILE=$ERL_TOP/${TRAVIS_TAG}-bundle.txt -OTP_FILE=$ERL_TOP/${TRAVIS_TAG}-bundle.tar.gz +REPOSITORIES="otp,$GIT_TAG corba,.*" -REPOSITORIES="otp,$TRAVIS_TAG corba,.*" +if [ ! -d $ERL_TOP/artifacts ]; then + mkdir $ERL_TOP/artifacts +fi mkdir bundle diff --git a/scripts/otp_html_check b/scripts/otp_html_check new file mode 100755 index 0000000000..62d5b47edd --- /dev/null +++ b/scripts/otp_html_check @@ -0,0 +1,536 @@ +#!/usr/bin/perl -w + +########################################################################### +# +# Find broken links and files not referenced. +# +# Author: Kent Boortz <kent@erix.ericsson.se> +# +########################################################################### + +use File::Find; +use strict; + +undef $/; # No record separator reading files + +########################################################################### +# +# When we talk about "a page" we mean the actual page/file +# When we talk about "a link" we mean a referense to a page/file. +# All links/URL's start with an slash except the top link that is +# the empty string. +# +# So basically we have a set of links and a set of URL's to pages and +# check if this is a valid combination. +# +########################################################################### + +my $debug = 1; +my $expand_url = 0; # If we are to expand an URL with default + # names like "index.html" +my @indexes = # The order to try URL expansion + ( + "index.shtml", + "index.html", + "index.htm", + ); + +my $html_ext = 'shtml|html|htm'; # HTML pages ends in these + +my @links; # Set of [page,link] we want to check +my @exclude; # Pages/dir/prefix to exclude +my %pages; # Set of all files found in the file system + # limited by the script arguments. + # After the spider is done all members in the + # set thas has the value 1 was visited. + +my %missing; # Pages not found "$page$;$link" +my %invalid; # After expansion it is invalid +my %access; # Can't access but exists + +my %anchor_refs; # Absolute links including anchor part +my %anchor_defs; # <a name="..."> in the form "$page#$anchor" + +########################################################################### +# +# Argument processing, see usage() function below +# +########################################################################### + +@ARGV or usage("No base directory given"); +my $base = shift @ARGV; +-d $base or usage("Not a directory: $base"); +$base =~ m&^/& or usage("Has to be absolute path: $base"); +$base =~ s&/+$&&; # Remove ending slash if any + +my $link; +while ($link = shift @ARGV) { + last if $link eq '--'; + $link =~ s&/+$&&; # Remove ending slash if any + $link =~ s&$base&&; # Make absolute URL + $link =~ m&^/& and usage("Invalid start point of HTML tree \"$_\""); + $link = "/$link"; + push(@links,["",$link]); +} + +while ($link = shift @ARGV) { + $link =~ s&/+$&&; # Remove ending slash if any + $link =~ s&$base&&; # Make absolute URL + $link =~ m&^/& and usage("Invalid exclude URL \"$_\""); + $link = "/$link"; + push(@exclude,$link); +} + +# OTP specific + +push(@links,["","/doc/index.html"]) unless @links; + +########################################################################### +# +# Traverse all files and directories and put all possible URL's into +# the set %pages. When we later find a referense to a page that URL +# is removed from the set. When we have followed all links the set +# contains the pages never visited. +# +# We skip files and directories in @exclude. +# +########################################################################### + +find(\&wanted,$base); + +sub wanted { + return unless -f; + return if /^\.info\./; + return if /~$/; + + my $url = $File::Find::name; + $url =~ s&$base&&; + $pages{$url} = 0 unless map {$url =~ m&^$_&} @exclude; +} + + +########################################################################### +# +# Spider that follow all links adding links to the @links set. +# +# @links is expanded, normalized links +# +# We check if there is an valid URL for this link. +# @links may contain links that look bad, this is cleaned up here +# before checking it. +# +########################################################################### + +while (@links) { + my $page_and_link = shift @links; + my ($page,$link) = @$page_and_link; + + # We skip some links directly + + next if $link =~ /^\w{3,10}:/i; + next if $link =~ /cgi-bin|cgiwrap|user-cgi/; + next if $link =~ /^and|or$/; +# next if $link eq ""; + +# print STDERR "1 link: $link\n"; + + $link = expand_link($link,\%pages) if $expand_url; + + unless (exists $pages{$link}) { + # No page for link, mark as invalid + $missing{"$page$;$link"} = 1; + next; + } + +# print STDERR "2 link: $link\n"; + + next if $pages{$link}; # If == 1 it is visited + $pages{$link} = 1; # Mark as visited + +# print STDERR "3 link: $link\n"; + +# next unless $link =~ /\.(shtml|html|htm)$/oi; + next unless $link =~ /\.($html_ext)$/oi; + + push(@links,get_page_links($base,$link)); +} + + +########################################################################### +# +# Read the page and get all the links. We know that the URL for the page +# is absolute and that a page/file exists. +# +########################################################################### + +sub get_page_links { + my $base = shift; + my $page = shift; # Absolute URL + +# print STDERR "open: $page\n"; + + my $path = "$base$page"; + + open(HTML,$path) + or print STDERR "INTERNAL ERROR: Can't open page $page: $!\n"; + + my $html = <HTML>; + close HTML; + +# my $url_base = $page; +# $url_base =~ s&/[^/]+$&&; + + # Remove comments + $html =~ s/\<\!\-\-\s*(.*?)\s*\-\-\>//gs; + +# # Remove comments and expand SSI +# $html =~ s/\<\!\-\-\s*(.*?)\s*\-\-\>/ +# expand_ssi($url_base,$page,$1)/gsie; + + my @links; # Links in this document +# push(@links,$html =~ /\/\*URL\*\/\s*\'([^\']+\.[^\']+)\'/gsi); +# push(@links,$html =~ /=\s*\'([^\']+\.(?:gif|jpg|jpeg))\'/gsi); +# push(@links,$html =~ /option value=\s*\"(\/[^\"]+)\"/gsi); +# push(@links,$html =~ /option value=\s*\"([^\"]+\.[^\"]+)\"/gsi); +# FIXME: This is not working.... +# push(@links,$html =~ /url\s*=\s*([\w-\.\/]+)/gsi); +# push(@links,$html =~ /\"([^\"]+\.html)\"/gsi); + + # Find real HTML links + push(@links,$html =~ /\<\s*\w[^\>]*\sHREF=\s*\"([^\"]*)\"[^\>]*\>/gsi); + push(@links,$html =~ /\<\s*\w[^\>]*\sSRC=\s*\"([^\"]*)\"[^\>]*\>/gsi); + push(@links,$html =~ /\<\s*\w[^\>]*\sLOWSRC=\s*\"([^\"]*)\"[^\>]*\>/gsi); + push(@links,$html =~ /\<\s*\w[^\>]*\sBACKGROUND=\s*\"([^\"]*)\"[^\>]*\>/gsi); + + # FIXME: Now we have the raw links, if we want to complain about + # spaces etc this is the time. + + # Remove referenses to the same page FIXME??? Was removed , why... +# @links = grep {$_ and $_ !~ /^\#/} @links; + + # Find the URL to the current directory + my $rpath = $page; + $rpath =~ s&/[^/]+$&&; # Remove name + + # Links pointing to the same page + # should look the same + map {$_ = normalize_link($page,$rpath,$_)} @links; + +# print "XXX $page\n" if grep {m&lib/asn1-1.3.2/doc/index\.html&} @links; + + map {$_ = [$page,$_]} @links; # Add what page was referensing it + + # Find the anchors + + my @anchors = + ($html =~ m/ + < + \s* + A + [^>]* + \s (?: NAME|ID) \s* = \s* + (?: \"([^\"]*)\" | \'([^\']*)\' | ([^>\s]+) ) + [^>]* + > + /gsix); + + foreach my $anchor (@anchors) { + # FIXME if already there, duplicate + next unless defined $anchor; + $anchor =~ s/%([\da-fA-F]{2})/chr(hex($1))/eg; # Translate hex to char + $anchor =~ s/</</g; # + $anchor =~ s/>/>/g; # + $anchor_defs{"$page#$anchor"} = 1; + } + + return @links; +} + + +# ------------------------------------------------------------------------- +# ------------------------------------------------------------------------- + +sub normalize_link { + my $page = shift; # Page where we found this link + my $rpath = shift; # URL to directory where we found this link + my $link = shift; # The link to normalize + +# print STDERR "\n"; +# print STDERR "1 normalize_link: $link\n"; + + # Handle javascript:erlhref() specially to be able to check those links. + if ($link =~ /^javascript:erlhref\(([^\)]*)\);$/) { + my($up,$part,$mod) = split(/,\s*/, $1); + $up =~ tr/\'//d; + $part =~ tr/\'//d; + $mod =~ tr/\'//d; + my $dir; + if ($part =~ m&^[a-z]+/&) { + $dir = "$base$rpath/${up}/$part"; + } else { + my $path = "$base$rpath/${up}lib/$part/doc/html"; + ($dir) = <$path-*>; + return $link unless defined $dir; + } + $dir =~ s&^$base&&o; + $link = "$dir/$mod"; + } + + return $link if $link =~ /^\w{3,10}:/i; # mailto: http: ..... + + $link =~ s/%([\da-fA-F]{2})/chr(hex($1))/eg; # Translate hex to char + + if ($link eq "") { + # The empty link is a reference to URL directory + return $rpath; + } elsif ($link =~ /^#(.*)$/s) { + # Lokal reference to anchor + my $anchor = $1; + $anchor =~ s/%([\da-fA-F]{2})/chr(hex($1))/eg; # Translate hex to char + $anchor =~ s/</</g; # + $anchor =~ s/>/>/g; # + $anchor =~ s&^\s+&&; # Remove leading any whitespaces + $anchor =~ s&\s+$&&; # Remove trailing any whitespaces + push(@{$anchor_refs{"$page#$anchor"}}, $page); + return $page; + } + + my $anchor = ""; + + if ($link =~ s&#(.*)$&&s) { + # Removed page ref (anchor) + $anchor = $1; + $anchor =~ s/%([\da-fA-F]{2})/chr(hex($1))/eg; # Translate hex to char + $anchor =~ s/</</g; # + $anchor =~ s/>/>/g; # + $anchor =~ s&^\s+&&; # Remove leading any whitespaces + $anchor =~ s&\s+$&&; # Remove trailing any whitespaces + } + + $link = "" if $link eq "/"; + + # Make the link absolute + # FIXME: maybe move down..... + + if ($link !~ m&^/&) { + if ($link) { + $link = "$rpath/$link"; + } else { + $link = $rpath; + } + } + + my $xlink = $link; + + $link =~ s&//+&/&g; # Replace multiple slashes with one slash +# $link =~ s&^(\./)+&&g; # Remove starting dot slash "./" (can't be if absolute) + $link =~ s&(/\.)+$&&; # Remove ending slash dot "/." + $link =~ s&(/\.)+/&/&g; # Remove all slash dot slash "/./" + $link =~ s&/+$&&; # Remove ending slashes + $link =~ s&\?.*$&&; # Remove any query parameters + + # Remove a real directory part followed by ".." + + while ($link =~ s&/[^/]+/\.\.&&) {} + +# print STDERR "4 normalize_link: $link\n"; + + $link = "" if $link eq "/"; # We do this again + + # print STDERR "5 normalize_link: $link\n"; + + push(@{$anchor_refs{"$link#$anchor"}}, $page) if $anchor; + + return $link; +} + + +# ------------------------------------------------------------------------- +# We know the link is normalized +# ------------------------------------------------------------------------- + +sub expand_link { + my $link = shift; + my $pages = shift; + + return $link if exists $pages{$link}; + + my $newlink; + + foreach my $index (@indexes) { + $newlink = "$link/$index"; + return $newlink if exists $pages{$newlink}; + } + + return $link; +} + +########################################################################### +# +# Report the result +# +########################################################################### + +if (keys %missing) { + print "\n\n\n**** Broken links\n\n"; + foreach (sort keys %missing) { + my ($page,$link) = split($;); + print qq(Broken Link: $page -> "$link"\n); + } +} + + +# Entrys in %pages that has the value 0 is not visited +if (keys %pages) { + print "\n\n\n**** Files not used (that I can see)\n\n"; + foreach my $page (sort keys %pages) { + next if $pages{$page}; # If == 1 it is visited + + # OTP specific + + next if $page =~ m&^/(man|pdf|logs|COPYRIGHT|PR.template|README)&; + next if $page =~ m&^/.*\.tar.gz$&; + next if $page =~ m&(/info|\.kwc)$&; + + print qq("$page"\n); + } +} + + +# Remove all references that has a matching NAME=.... +map {delete $anchor_refs{$_}} keys %anchor_defs; + +if (keys %anchor_refs) { + print "\n\n\n**** References to missing anchors\n\n"; + foreach my $ref (sort keys %anchor_refs) { + foreach my $anchor (sort @{$anchor_refs{$ref}}) { + print qq(Missing Anchor: "$ref" from ${anchor}\n); + } + } +} + + +########################################################################### + +sub usage { + print STDERR "ERROR: ",join("\n",@_),"\n" if @_; + print <<HERE; +Usage: $0 BaseDirectory URL [ URLs... ] [ -- ExcludeURLs... ] + +This script try to find out what files are used and not of your +HTML documents, graphic files etc. It doesn't use HTTP, i.e. you +work off-line, so this script may fail to find a link. Javascripts +and other extensions also makes it very hard. But for many sites +it work very well. + +The base directory has to given has to start with a slash. + +For URLs and ExcludeURLs absolute paths or relative the base +directory can be used. + +ExcludeURLs is used as prefixes of directories or files that +should be excluded from the search. + +You call it something like + + % $0 /test/r7a /test/r7a/doc/index.html /test/r7a/lib/*/doc/index.html + +or using relative start points + + % $0 /test/r7a doc/index.html + +HERE + exit 1; +} + + +__END__ + +# FIXME: The order below is important + +if (%access) { + print "\n**** Link exists but can't open\n\n"; + + my $file; + + foreach $file (sort keys %access) { + print "$file\n"; + } +} + + +if (%invalid) { + print "\n**** Invalid links (goes up above top directory)\n\n"; + + foreach (sort keys %invalid) { + my ($page,$link) = split($;,$_); + delete $done{$link}; # FIXME: xxxx + print "$page\n\t-> $link\n"; + } +} + +if (%done) { + print "\n**** Internal error, should be no files here\n\n"; + + foreach (sort keys %done) { + print "$_\n"; + } +} + + +__END__ +########################################################################### + + +sub expand_ssi { + my $url_base = shift; + my $page = shift; + my $comment = shift; # Text between <!-- and --> + + return "" unless $comment =~ s/^\#//; + + # This is an SSI + unless ($comment =~ /([\w-]+)=\"([^\"]+)\"/) { +# print STDERR "WARNING: Unknown SSI $comment\n\ton $page\n"; + return ""; + } + + my $op = lc($1); # Operator + my $inc = $2; # Absolute or relative URL anding in anything + + if ($debug) { + print STDERR "X: url_base = $url_base\n"; + print STDERR "X: page = $page\n"; + print STDERR "X: op = $op\n"; + print STDERR "X: inc = $inc\n"; + print STDERR "X: base = $base\n"; + } + + unless ($op eq 'virtual') { +# print STDERR "WARNING: Unknown SSI $comment\n\ton $page\n"; + return ""; + } + + $inc = make_url_absolute($url_base,$page,$inc); + + my $path = "$base$inc"; + + if ($debug) { + print STDERR "X: inc = $inc\n"; + print STDERR "X: path = $path\n\n"; + } + + unless (open(HTML,$path)) { +# print STDERR "ERROR: Can't open page $inc: $!\n"; + $access{$inc} = 1; + return ""; + } + + my $html = <HTML>; + close HTML; + + $done{$inc} = 1; # Mark done + + return $html; +} + diff --git a/scripts/run-smoke-tests b/scripts/run-smoke-tests index b3d26f1fce..82231a2b81 100755 --- a/scripts/run-smoke-tests +++ b/scripts/run-smoke-tests @@ -1,19 +1,20 @@ #!/bin/bash set -ev -if [ -z "$ERL_TOP" ]; then - ERL_TOP=$(pwd) +if [ -d $ERL_TOP/release/tests/test_server ]; then + cd $ERL_TOP/release/tests/test_server +elif [ -d test_server ]; then + cd test_server +else + echo "Could not find tests" + exit 1; fi -function run_smoke_tests { - cd $ERL_TOP/release/tests/test_server - $ERL_TOP/bin/erl -s ts install -s ts smoke_test batch -s init stop +erl -noshell -s ts install -s ts smoke_test batch -s init stop - if grep -q '=failed *[1-9]' ct_run.test_server@*/*/run.*/suite.log; then - echo "One or more tests failed." - exit 1 - fi - rm -rf ct_run.test_server@* -} +if grep -q '=failed *[1-9]' ct_run.test_server@*/*/run.*/suite.log; then + echo "One or more tests failed." + exit 1 +fi -run_smoke_tests +rm -rf ct_run.test_server@* |