SCM

SCM Repository

[logging] View of /handlers/pkg/R/sentry.R
ViewVC logotype

View of /handlers/pkg/R/sentry.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 102 - (download) (annotate)
Thu Apr 19 11:28:35 2012 UTC (2 years, 2 months ago) by mariotomo
File size: 4438 byte(s)
adjustments related to initialization of handlers at addition to loggers.
this is not too well documented I fear (handler actions should expect an extra 'dry' parameter and if it is present they should return a logical value expressing whether or not the handler is completely specified.).
##***********************************************************************
## this program is free software: you can redistribute it and/or
## modify it under the terms of the GNU General Public License as
## published by the Free Software Foundation, either version 3 of the
## License, or (at your option) any later version.
##
## this program is distributed in the hope that it will be useful, but
## WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
## General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with the nens libraray.  If not, see
## <http://www.gnu.org/licenses/>.
##
## Copyright © 2011, 2012 by Mario Frasca
##
## Library    : logging
##
## Purpose    : implement a sentry logging handler
##
## Usage      : library(logging.handlers)
##
## $Id$
##
## initial programmer :  Mario Frasca
##
## initial date       :  20110426
##

sentryAction <- function(msg, conf, record, ...) {
  if(!all(c(require(RCurl),
            require(Ruuid),
            require(rjson),
            require(digest))))
    stop("sentryAction depends on RCurl, Ruuid, rjson, digest.")

  ## you install Ruuid this way (not with install.packages).
  ## source("http://bioconductor.org/biocLite.R")
  ## biocLite("Ruuid")

  if(exists('dsn', envir=conf)) {
    ## first time doing something with this handler: parse the dsn
    glued <- gsub('(.*)://(.*):(.*)@([^/]+)(.*)/(\\w)', '\\1://\\4\\5::\\2::\\3::\\6',
                  with(conf, dsn), perl=TRUE)
    parts <- strsplit(glued, "::")[[1]]
    assign('server', parts[1], envir=conf)
    assign('sentry.public.key', parts[2], envir=conf)
    assign('sentry.private.key', parts[3], envir=conf)
    assign('project', parts[4], envir=conf)
    rm('dsn', envir=conf)
  }

  anythingMissing <- !sapply(c("server", "sentry.private.key", "sentry.public.key", "project"),
                             exists, envir=conf)

  if(length(list(...)) && 'dry' %in% names(list(...))) {
    return(all(!anythingMissing))
  }

  if(any(anythingMissing)) {
    missing <- names(anythingMissing)[anythingMissing]
    stop(paste("this handler with sentryAction misses ", paste(missing, collapse=", "), ".\n", sep=""))
  }

  sentry.server <- with(conf, server)
  sentry.private.key <- with(conf, sentry.private.key)
  sentry.public.key <- with(conf, sentry.public.key)
  project <-  with(conf, project)
  client.name <- tryCatch(with(conf, client.name), error = function(e) "r.logging")

  if(missing(record))  # needed for `level` and `timestamp` fields.
    stop("sentryAction needs to receive the logging record.\n")

  ## `view.name`: the name of the function where the log record was generated.
  functionCallStack <- sys.calls()
  view.name <- tryCatch({
    perpretator.call <- functionCallStack[length(functionCallStack) - 4][[1]]
    perpretator.name <- as.character(perpretator.call)[[1]]
    view.name <- perpretator.name
  }, error = function(e) "<interactive>")

  params <- list("project" = project,
               "event_id" = gsub("-", "", as.character(getuuid())),
               "culprit" = view.name,
               "timestamp" = record$timestamp,
               "message" = msg,
               "level" = as.numeric(record$level),
               "logger" = record$logger,
               "server_name" = client.name)

  metadata <- list()
  metadata$call_stack <- paste(lapply(functionCallStack, deparse), collapse=" || ")
  params$extra <- metadata

  repr <- as.character(toJSON(params))

  url <- paste(sentry.server, "api", "store", "", sep="/")

  timestamp <- Sys.time()
  timestampSeconds <- format(timestamp, "%s")
  to.sign <- paste(timestampSeconds, repr, sep=' ')
  signature <- hmac(sentry.private.key, to.sign, "sha1")

  x.sentry.auth.parts <- c(paste("sentry_version", "2.0", sep="="),
                           paste("sentry_signature", signature, sep="="),
                           paste("sentry_timestamp", timestampSeconds, sep="="),
                           paste("sentry_key", sentry.public.key, sep="="),
                           paste("sentry_client", "r-logging.handler", sep="="))
  x.sentry.auth <- paste("Sentry", paste(x.sentry.auth.parts, collapse=", "))
  hdr <- c('Content-Type' = 'application/octet-stream', 'X-Sentry-Auth' = x.sentry.auth)

  httpPOST(url, httpheader = hdr, postfields = toJSON(params))

}

R-Forge@R-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business University of Wisconsin - Madison Powered By FusionForge