Posted to tcl by guest4 at Thu Nov 11 08:19:30 GMT 2021view raw

  1. ################################################################################
  2. # Tcl extension
  3.  
  4. // redirecttcl.c: redirect stdout to systemd journal.
  5.  
  6. #include <sys/types.h>
  7.  
  8. #include <assert.h>
  9. #include <err.h>
  10. #include <errno.h>
  11. #include <stdbool.h>
  12. #include <stdio.h>
  13. #include <stdlib.h>
  14. #include <string.h>
  15. #include <unistd.h>
  16.  
  17. #define SD_JOURNAL_SUPPRESS_LOCATION
  18. #include <systemd/sd-journal.h>
  19.  
  20. #include <tcl.h>
  21.  
  22. //----------------------------------------------------------------------
  23.  
  24. #ifndef UNUSED
  25. # define UNUSED(x) (void)(x)
  26. #endif
  27.  
  28. #if !defined(INT2PTR)
  29. # define INT2PTR(p) ((void*)(intptr_t)(p))
  30. #endif
  31.  
  32. static int RedirectCmd(ClientData clientData, Tcl_Interp* interp, int objc, Tcl_Obj* const objv[]) {
  33. UNUSED(clientData);
  34. UNUSED(objc);
  35. UNUSED(objv);
  36.  
  37. int fd = sd_journal_stream_fd("STDOUT-REDIRECTED", LOG_NOTICE, 0);
  38. fprintf(stderr, "-- %s: fd=%d\n", __func__, fd);
  39. fprintf(stderr, "-- %s: isatty=%d\n", __func__, isatty(fd));
  40. if (fd < 0) {
  41. Tcl_SetObjResult(interp, Tcl_ObjPrintf("failed to get journal fd: %s", Tcl_PosixError(interp)));
  42. return TCL_ERROR;
  43. }
  44.  
  45. Tcl_Channel chan = Tcl_MakeFileChannel(INT2PTR(fd), TCL_WRITABLE);
  46.  
  47. Tcl_SetStdChannel(chan, TCL_STDOUT);
  48.  
  49. Tcl_RegisterChannel(0, chan);
  50.  
  51. if (1) {
  52. int rc = Tcl_SetChannelOption(0, chan, "-buffering", "none");
  53. fprintf(stderr, "-- %s: Tcl_SetChannelOption -buffering none=%d\n", __func__, rc);
  54. Tcl_SetChannelOption(0, chan, "-translation", "auto crlf");
  55. fprintf(stderr, "-- %s: Tcl_SetChannelOption -translation auto crlf=%d\n", __func__, rc);
  56. }
  57.  
  58. return TCL_OK;
  59. }
  60.  
  61.  
  62. DLLEXPORT int Redirecttcl_Init(Tcl_Interp * interp) {
  63. if (!Tcl_InitStubs(interp, "8.6", 0))
  64. return TCL_ERROR;
  65.  
  66. Tcl_CreateObjCommand(interp, "redirect", RedirectCmd, 0, NULL);
  67.  
  68. if (Tcl_PkgProvide(interp, "redirect", "0.1") != TCL_OK)
  69. return TCL_ERROR;
  70.  
  71. return TCL_OK;
  72. }
  73.  
  74. ################################################################################
  75. # Tcl driver:
  76.  
  77. puts PID=[pid]
  78. puts ""
  79.  
  80. proc demo {} {
  81. for {set i 0} {$i < 10} {incr i} {
  82. puts "round $i"
  83. after 1000
  84. }
  85. }
  86.  
  87. try {
  88. load redirecttcl.so
  89. puts "CHANNELS BEFORE: [chan names]"
  90. redirect
  91. puts "CHANNELS AFTER: [chan names]"
  92. demo
  93. } on ok {} {
  94. puts "DONE!"
  95. } on error {err opt} {
  96. catch {puts stderr "ERROR: $err"}
  97. catch {puts stderr "OPTIONS: $opt"}
  98. }
  99.  
  100. ################################################################################
  101. # output:
  102.  
  103. PID=2717
  104.  
  105. CHANNELS BEFORE: stdin stdout stderr
  106. -- RedirectCmd: fd=3
  107. -- RedirectCmd: isatty=0
  108. -- RedirectCmd: Tcl_SetChannelOption -buffering none=0
  109. -- RedirectCmd: Tcl_SetChannelOption -translation auto crlf=0
  110. CHANNELS AFTER: stdin file1 stderr stdout
  111. round 0
  112. round 1
  113. round 2
  114. round 3
  115. round 4
  116. round 5
  117. round 6
  118. round 7
  119. round 8
  120. round 9
  121. DONE!
  122.