2023-12-25

unixODBC isql

unixODBC 提供了 isql 這個命令列工具。要注意的是,有不少資料庫的命令列工具也取名為 isql,使用前應該先使用下列的指令確定:

isql --version

下面是指令的參數:

isql DSN [USER [PASSWORD]] [options]

下面的範例是使用 DSN=PostgreSQL 查詢資料庫版本,並且輸出為 html 的例子:

echo "select version() as version" | isql PostgreSQL -b -w > result.html

(-b 代表不要 interactive mode,而 -w 代表輸出 html table 結果。)

然後接下來撰寫一個 Tcl 程式測試:

#!/usr/bin/env tclsh
if {$argc >= 1} {
    set statement [lindex $argv 0]
} elseif {$argc == 0} {
    puts "Please input a SQL statement"
    exit
}

set var [list echo $statement | isql PostgreSQL -b -w > result.html]
exec {*}$var

2023-11-30

tcl-monetdbe v0.2.0

 tcl-monetdbe


Tcl extension and TDBC driver for MonetDB Embedded.

MonetDB Embedded (MonetDB/e) 已經出現了一段時間,是 MonetDB 的 embedded solution。因為 MonetDB 我只是用來測試一些想法,所以之前一直沒有使用 MonetDB/e 的場合。

不過因為電腦上有裝 MonetDB 而且我也有安裝 MonetDB embedded library,所以考慮了一下,最近嘗試寫一個 Tcl extension 測試看看使用的情況。

2023-11-23

tdbc::mysql

最近我在整理自己的作業環境,這才發現 libmariadb-devel 對於 tdbc::mysql 而言是非必要的(以前因為 so suffixes 的關係需要裝,但是其實 tdbc::mysql 已經修正了,只是我沒注意到)。下面就是目前的 code:

static const char *const mysqlStubLibNames[] = {
    /* @LIBNAMES@: DO NOT EDIT THESE NAMES */
    "mariadbclient", "mariadb", "mysqlclient_r", "mysqlclient", "mysql", NULL
    /* @END@ */
};

/* ABI Version numbers of the MySQL API that we can cope with */

static const char mysqlSuffixes[][4] = {
    "", ".3", ".21", ".20", ".19", ".18", ".17", ".16", ".15"
};

如果說 MariaDB 是為了防止 Oracle 更改 MySQL 的授權而成立的,可是那為什麼 Michael Widenius 除了基金會,還又成立了一家企業?嘴上說我不是要用 MySQL 或者是 MariaDB 賺錢,實際上的行為卻完全相反,這是一個與說法衝突的行為(還可以參考 Uproar: MariaDB Corp. veers away from open source)。如果採用 MySQL 是被騙第一次,那 MariaDB 被騙第二次的人就應該要自我檢討了。我是說如果你擔心 Oracle 會對 MySQL 做出什麼損壞開放原始碼的事情,那麼 Michael Widenius 也可以重施故技,又賣掉 MariaDB 企業或者是上市賺取利益。

也就是說,我不認為應該要採用 MySQL 或者是 MariaDB。當然不是所有人都可以直接切換到其它的資料庫,這個時候可以考慮採用 MySQL protocol 並且高度相容的其它資料庫,在這個情況下,client 端的 source code 的變動理論上要很少,而 server 端則是換掉 MySQL 或者是 MariaDB,採用其它相容方案的資料庫。

在這個情況下,MySQL/MariaDB client API 是很重要的,而又剛好 MySQL/MariaDB client API 極大多數是 LGPL 或者是較為寬鬆的條款,只要採用動態連結的使用方式就可以在商業環境下使用,所以保留 MySQL/MariaDB client library,然後從MySQL 或者是 MariaDB 遷移出去。 

不過如果是因為學習 LAMP 架構而需要安裝一個資料庫,或者是撰寫開放原始碼的軟體,那麼 MySQL 與 MariaDB 我想可以考慮 MariaDB;理由也很簡單,因為大多數的 Linux distribution 都有內建的套件可以安裝(只是版本可能會比較舊不是最新的)。然後要小心資料庫專屬的功能,小心的避掉廠商鎖定的風險。

2023-11-22

tkimg 1.4.16

tkImg

 

tkimg 提供了更多影像格式的支援 (BMP, GIF, ICO, JPEG, PCX, PNG, PPM, PS, SGI, SUN, TGA, TIFF, XBM, XPM),最近釋出了 1.4.16 的新版本。

2023-11-15

DuckDB and ODBC

 DuckDB 是一套 in-process SQL OLAP database management system,所以是使用 DuckDB 在單機分析數據,也可以內嵌到應用程式。

因為有提供 ODBC interface,所以我使用 TDBC-ODBC 測試一下是否可以連線。

下載後解開壓縮檔,將二個檔案放在某個目錄(我是放在家目錄下的 Programs)。

首先在 Linux 執行需要有安裝 unixODBC。雖然 DuckDB 有提供 unixodbc_setup.sh 可以建立設定檔,不過需要python 以及相關的函式庫有安裝,所以我在執行時發生錯誤。不過只是要建立 ODBC 設定,DuckDB 在文件上也有提供相關的內容,所以自行在家目錄下建立以下二個檔案即可。

.odbc.ini

[DuckDB]
Driver = DuckDB Driver
Database=:memory:

.odbcinst.ini

[ODBC]
Trace = yes
TraceFile = /tmp/odbctrace

[DuckDB Driver]
Driver = /home/danilo/Programs/libduckdb_odbc.so

接下來就寫一個簡單的 script 測試。

package require tdbc::odbc

set connStr "DSN=DuckDB;"
if {[catch {tdbc::odbc::connection create db $connStr}]} {
   puts "Connection failed."
   exit
}

set statement [db prepare {SELECT VERSION() as version}]

puts "DuckDB version:"
$statement foreach row {
    puts [dict get $row version]
}

$statement close
db close

如果有印出 DuckDB 的版本,就表示可以透過 ODBC 來使用 DuckDB 了。

2023-11-14

tclcubrid v0.9.6

Source code
tclcubrid


附帶一提,要注意的是,CUBRID 使用 NCURSES 5 API,所以在 openSUSE 上使用,如果 NCRUSES 版本已升級到 6, 那麼需要安裝 NCURSES 6 所提供的與 5 ABI 相容的函式庫:

sudo zypper in libncurses5

我看了一下 tclcubrid 在 CUBRID 11.3 的執行情況,發現會有問題,所以更新了 CCI header files 嘗試解決問題;以及 CUBRID 10.2 有加入 JSON type,我在 v0.9.6 也嘗試加入 JSON type 的支援。

2023-11-03

openSUSE: Lighttpd and Tcl CGI

Lighttpd 是一款以 BSD 授權條款開源的網頁伺服器, 設計目的以安全、快速、小巧為主要設計理念。Lighttpd 和 Nginx 都是主打性能(二者的效能在伯仲之間)的網頁伺服器, 同時在使用情況上有一定範圍的重覆,只是 Lighttpd 在開始搶佔市佔率的時候被發現有一些 memory leak 的問題, 雖然在之後陸陸續續問題有所修正,但是在之後已無法取得更多的市佔率。

即使如此,當使用的情況主要是以靜態網頁為主並且不需要太多功能(Lighttpd 的 memory leak 主要發生在動態網頁, 而 Lighttpd 在靜態網頁方面十分高效),或者是在硬體有一些限制的情況下,需要設定簡單、輕量級的網頁伺服器, 就十分適合使用 Lighttpd。另外,和 Nginx 不同的是,Lighttpd 同時支援 CGI 與 FastCGI。

Install Lighttpd (@openSUSE):

sudo zypper install lighttpd

注意:Lighttpd 的 conf 目錄在 openSUSE 權限設定為 640,所以一般使用者無法直接讀取。


使用下列的指令查看 Lighttpd 的版本資訊,有 ssl 字樣表示支援 SSL。

sudo lighttpd -v

接下來使用自簽憑證設定 HTTPS。
首先建立 ssl.conf 設定檔:

[req]
prompt = no
default_md = sha256
default_bits = 2048
distinguished_name = dn
x509_extensions = v3_req

[dn]
C = TW
ST = Taiwan
L = Taipei
O = Orange Inc.
OU = IT Department
emailAddress = admin@example.com
CN = localhost

[v3_req]
subjectAltName = @alt_names

[alt_names]
DNS.1 = *.localhost
DNS.2 = localhost
IP.1 = 127.0.0.1

透過指令建立開發測試用途的自簽憑證:

openssl req -x509 -new -nodes -sha256 -utf8 -days 3650 \
-newkey rsa:2048 -keyout lighttpd.key -out lighttpd.csr -config ssl.conf

可以透過以下指令查看 lighttpd.csr 內容:

openssl x509 -in lighttpd.csr -text

使用下列的指令產生 lighttpd.pem:

cat lighttpd.key lighttpd.csr > lighttpd.pem

建立 /etc/lighttpd/ssl 目錄,將 lighttpd.pem 複製到 /etc/lighttpd/ssl 目錄下。

修改 /etc/lighttpd/modules.conf,加入下列的內容:

server.modules = (
#  "mod_rewrite",
  "mod_access",
#  "mod_auth",
#  "mod_authn_file",
#  "mod_redirect",
#  "mod_setenv",
#  "mod_alias",
   "mod_openssl",
)

修改 /etc/lighttpd/lighttpd.conf,加入下列的內容:

$SERVER["socket"] == ":443" {
        ssl.engine = "enable"
        ssl.pemfile = "/etc/lighttpd/ssl/lighttpd.pem"
        server.name = "localhost"
        server.document-root = "/srv/www/htdocs/"
}

Lighttpd 自 1.4.56 開始支援 HTTP/2(目前預設值為啟用)。
如果你想要嘗試 enable/disable HTTP/2,使用下列的設定:

server.feature-flags += ("server.h2proto" => "enable")

CGI

接下來加入 CGI 支援。

修改 /etc/lighttpd/modules.conf,修改並加入下列的內容:

server.modules = (
#  "mod_rewrite",
  "mod_access",
#  "mod_auth",
#  "mod_authn_file",
#  "mod_redirect",
#  "mod_setenv",
   "mod_alias",
   "mod_cgi",
   "mod_openssl",
)

修改 /etc/lighttpd/lighttpd.conf,加入下列的內容(因為要使用 Tcl 寫 CGI 程式, 所以要避免被視為靜態檔案):

static-file.exclude-extensions = ( ".tcl", ".php", ".pl", ".fcgi", ".scgi" )

Lighttpd 的 CGI 主要可以有二種風格的設定方式,一種是以 file extension 為主:

cgi.assign = ( ".tcl"  => "/usr/bin/tclsh",
               ".cgi" => "/usr/bin/tclsh" )

另外一種則是配合 mod_alias,將 CGI 程式放在 /cgi-bin:

# For execute CGI in /cgi-bin
alias.url += ( "/cgi-bin" => server_root + "/cgi-bin" )
$HTTP["url"] =~ "^/cgi-bin" {
   cgi.assign = ( "" => "" )
}

要使用何種風格的設定方式看使用者的喜好。

FastCGI

接下來是 FastCGI 的設定。
修改 /etc/lighttpd/modules.conf,修改並加入下列的內容:

server.modules = (
#  "mod_rewrite",
  "mod_access",
#  "mod_auth",
#  "mod_authn_file",
#  "mod_redirect",
#  "mod_setenv",
   "mod_alias",
   "mod_cgi",
   "mod_fastcgi",
   "mod_openssl",
)

spawn-fcgi

下面使用的方式配合 spawn-fcgi
我們需要撰寫 spawn-fcgi 的 systemd service,在 /usr/lib/systemd/system 目錄下建立 spawnfcgi.service,內容如下:

[Unit]
Description=Spawn FCGI service
After=nss-user-lookup.target

[Service]
Type=forking
Environment=WORKERS=1
ExecStart=/usr/bin/spawn-fcgi \
    -F ${WORKERS} \
    -u lighttpd \
    -g lighttpd \
    -a 127.0.0.1 -p 9000 \
    -P /var/run/%p.pid \
    -- /usr/bin/rivet-fcgi
Restart=on-failure
RestartSec=5

[Install]
WantedBy=multi-user.target

(其中 -u 指定 user,-g 指定 group,隨著平台的不同可能有不同的設定。)

下面是測試我自己寫的工具 rivet-fcgi 的設定, 修改 /etc/lighttpd/lighttpd.conf

fastcgi.server = (
    ".rvt" =>
        (( "host" => "127.0.0.1",
            "port" => 9000,
            "docroot" => "/srv/www/htdocs"
        )),
    ".tcl" =>
        (( "host" => "127.0.0.1",
            "port" => 9000,
            "docroot" => "/srv/www/htdocs"
        ))
)

而後啟動(或重新啟動)spawn-fcgi 與 lighttpd 的服務,接著進行測試是否有正確設定。

php-fpm

php-fpm 設定檔在 openSUSE 主要為 /etc/php8/fpm/php-fpm.d/www.conf。在安裝以候使用預設值就可以順利執行, 如果有需要再視自己的需求修改。

修改 /etc/lighttpd/lighttpd.conf,加入下面的設定:

fastcgi.server = (
    ".php" =>
        (( "host" => "127.0.0.1",
            "port" => 9000,
            "docroot" => "/srv/www/htdocs"
        ))
)

而後啟動(或重新啟動)spawn-fcgi 與 lighttpd 的服務,接著進行測試是否有正確設定。 在 /srv/www/htdocs 目錄下建立 info.php:

<?php

phpinfo();

?>

如果瀏緊 info.php 可以得到資訊,就表示環境架設成功。

2023-11-02

Apache Rivet 3.2.3

 Apache Rivet 釋出了  3.2.x 系列的新版本,3.2.3。

下面是這個版本的更動:

  • Replaced CONST84 definitions with CONST86 in C code
  • Fixed [::rivet::raw_post] that failed when the POST request had no sections defined (contribution provided by Scott Pitcher)
  • Now virtual host interpreters log message into their log files also during ChildInitScript stage

2023-10-28

Capturing stdout and stderr in C or C++ program

Capturing stdout and stderr in C or C++ program

 

如果將 Tcl 內嵌在 C 或者 C++ 程式內,程式用來獲取 Tcl stdout 輸出的方法。下面是我使用 clang-format 編排,並且為了練習將 -buffering 從 none 改為 line 的程式。

#include <iostream>
#include <cstring>
#include <tcl.h>

//
// Example class to catch stdout and stderr channel output.
//
// In the real world, this would be a GUI class (in Qt, KWWidgets etc)
// that makes the proper API calls to display the output in the right
// widget.
class TclIOCatcher {
public:
    void outputText(const char *buf, int toWrite) {
        std::cout << "-----TclIOCatcher--------------" << std::endl;
        std::cout.write(buf, toWrite);
        std::cout << "---------------------" << std::endl;
    }
};

//
// Tcl is pure C, and this is a C++ program; to ensure proper
// calling linkage, encapsulate callbacks in a extern "C" section.
extern "C" {
// outputproc is callback used by channel to handle data to outpu
static int outputproc(ClientData instanceData, CONST84 char *buf, int toWrite,
                      int *errorCodePtr) {
    // instanceData in this case is a pointer to a class instance
    TclIOCatcher *qd = reinterpret_cast<TclIOCatcher *>(instanceData);
    qd->outputText(buf, toWrite);
    return toWrite;
}
// inputproc doesn't do anything in an output-only channel.
static int inputproc(ClientData instancedata, char *buf, int toRead,
                     int *errorCodePtr) {
    return TCL_ERROR;
}
// nothing to do on close
static int closeproc(ClientData instancedata, Tcl_Interp *interp) { return 0; }
// no options for this channel
static int setoptionproc(ClientData instancedata, Tcl_Interp *interp,
                         CONST84 char *optionname, CONST84 char *value) {
    return TCL_OK;
}
// for non-blocking I/O, callback when data is ready.
static void watchproc(ClientData instancedata, int mask) {
    /* not much to do here */
    return;
}
// gethandleproc -- retrieves device-specific handle, not applicable here.
static int gethandleproc(ClientData instancedata, int direction,
                         ClientData *handlePtr) {
    return TCL_ERROR;
}
// Tcl Channel descriptor type.
// many procs can be left NULL, and for our purposes
// are left so.
Tcl_ChannelType TclChan = {
    "tclIOTestChan",       /* typeName */
    TCL_CHANNEL_VERSION_4, /* channel type version */
    closeproc,             /* close proc */
    inputproc,             /* input proc */
    outputproc,            /* output proc */
    NULL,                  /* seek proc - can be null */
    setoptionproc,         /* set option proc - can be null */
    NULL,                  /* get option proc - can be null */
    watchproc,             /* watch proc */
    gethandleproc,         /* get handle proc */
    NULL,                  /* close 2 proc - can be null */
    NULL,                  /* block mode proc - can be null */
    NULL,                  /* flush proc - can be null */
    NULL,                  /* handler proc - can be null */
    NULL,                  /* wide seek proc - can be null if seekproc is*/
    NULL                   /* thread action proc - can be null */
};
}

int main(int argc, char **argv) {
    Tcl_FindExecutable(argv[0]);

    // create instance of the Tcl interpreter
    Tcl_Interp *interp(Tcl_CreateInterp());
    Tcl_Init(interp);

    // class object to catch output
    TclIOCatcher test;

    // create a new channel for stdout
    Tcl_Channel m_Out =
        Tcl_CreateChannel(&TclChan, "testout", &test, TCL_WRITABLE);
    //
    // IMPORTANT -- tcl Channels do buffering, so
    // the output catcher won't get called until a buffer
    // is filled (default 4K bytes).
    // These settings are stolen from TkWish.
    Tcl_SetChannelOption(NULL, m_Out, "-translation", "lf");
    Tcl_SetChannelOption(NULL, m_Out, "-buffering", "line");
    Tcl_SetChannelOption(NULL, m_Out, "-encoding", "utf-8");
    //
    // make this new channel the standard output channel.
    Tcl_SetStdChannel(m_Out, TCL_STDOUT);
    //
    // I'm not sure why this is necessary, but apparently it has
    // something to do with how reference counting inside the interpeter works.
    Tcl_RegisterChannel(0, m_Out);

    //
    // do all the same stuff for stderr.  In our case, we push the
    // output all to the same place, but you could handle it seperately.
    Tcl_Channel m_Err =
        Tcl_CreateChannel(&TclChan, "testerr", &test, TCL_WRITABLE);

    Tcl_SetChannelOption(NULL, m_Err, "-translation", "lf");
    Tcl_SetChannelOption(NULL, m_Err, "-buffering", "line");
    Tcl_SetChannelOption(NULL, m_Err, "-encoding", "utf-8");

    Tcl_SetStdChannel(m_Err, TCL_STDERR);

    Tcl_RegisterChannel(0, m_Err);

    //
    // run one command to demonstrate how it works
    const char testcommand[] = "puts [info patchlevel]";
    int result = Tcl_EvalEx(interp, testcommand, strlen(testcommand), 0);
    // show the result, should be zero.
    std::cout << "Result = " << result << std::endl;
    Tcl_Finalize();
    exit(result);
}

然後撰寫一個簡單的 CMakeLists.txt 來使用 CMake 幫忙編譯程式:

cmake_minimum_required(VERSION 3.12 FATAL_ERROR)

# set the project name
project(capture VERSION 1.0 LANGUAGES CXX)

set(CMAKE_CXX_STANDARD 11)
set(CMAKE_CXX_STANDARD_REQUIRED True)

# find_package (TclStub REQUIRED)
find_package(TCL REQUIRED)

# add the executable
add_executable(capture capture.cpp)

target_link_libraries (capture ${TCL_LIBRARY})
include_directories (${TCL_INCLUDE_PATH})

2023-10-21

openSUSE: Nginx, fcgiwrap and Tcl CGI

Nginx 是非同步框架的網頁伺服器,在靜態檔案的效能上十分高效, 而且時常被用來作為反向代理、Http Cache、負載平衡器。

Install nginx (@openSUSE):

sudo zypper install nginx

如果要作為提供靜態檔案服務的 web server,openSUSE 的預設設定已經足夠, 下面只是我個人習慣更新 /etc/nginx/nginx.conf 加入下面的設定:

    server {
        listen       80;
        server_name  localhost;

        location / {
            root   /srv/www/htdocs/;
            try_files $uri/ $uri =404;
            index  index.html index.htm;
        }

        #error_page  404              /404.html;

        # redirect server error pages to the static page /50x.html
        #
        error_page   500 502 503 504  /50x.html;
        location = /50x.html {
            root   /srv/www/htdocs/;
        }
    }

接下來使用自簽憑證設定 HTTPS。
首先建立 ssl.conf 設定檔:

[req]
prompt = no
default_md = sha256
default_bits = 2048
distinguished_name = dn
x509_extensions = v3_req

[dn]
C = TW
ST = Taiwan
L = Taipei
O = Orange Inc.
OU = IT Department
emailAddress = admin@example.com
CN = localhost

[v3_req]
subjectAltName = @alt_names

[alt_names]
DNS.1 = *.localhost
DNS.2 = localhost
IP.1 = 127.0.0.1

透過指令建立開發測試用途的自簽憑證:

openssl req -x509 -new -nodes -sha256 -utf8 -days 3650 \
-newkey rsa:2048 -keyout nginx.key -out nginx.crt -config ssl.conf

將 nginx.key 與 nginx.crt 複製到 /etc/nginx/ssl 目錄(需要使用 su 切換到 root 身份或者使用 sudo)。

更新 /etc/nginx/nginx.conf 加入下面的設定:

    # HTTPS server
    #
    server {
        listen       443 ssl;
        server_name  localhost;

        ssl_certificate      /etc/nginx/ssl/nginx.crt;
        ssl_certificate_key  /etc/nginx/ssl/nginx.key;

        ssl_protocols        TLSv1.2 TLSv1.3;

    #    ssl_session_cache    shared:SSL:1m;
    #    ssl_session_timeout  5m;

    #    ssl_ciphers  HIGH:!aNULL:!MD5;
    #    ssl_prefer_server_ciphers  on;

        location / {
            root   /srv/www/htdocs/;
            try_files $uri/ $uri =404;
            index  index.html index.htm;
        }

        #error_page  404              /404.html;

        # redirect server error pages to the static page /50x.html
        #
        error_page   500 502 503 504  /50x.html;
        location = /50x.html {
            root   /srv/www/htdocs/;
        }        
    }

這樣就有一個支援 HTTPS 的 web server 可以用來測試。

如果要加入 HTTP/2 支援,更新 HTTPS 設定如下(NgINX 1.9.5 以上才有用):

        listen       443 ssl http2;

啟動 Nginx:

sudo systemctl start nginx

如果要在重新開機後會自動啟動 nginx server,使用下列的指令:

sudo systemctl enable nginx

因為 Nginx 支援 FastCGI 但是不支援 CGI, 所以需要 fcgiwrap 將網頁請求透過 FastCGI 協定傳給 CGI 程式執行。 如果有執行 CGI 的需求才需要安裝 fcgiwrap。

Install fcgiwrap (@openSUSE):

sudo zypper install fcgiwrap fcgiwrap-nginx

fcgiwrap 安裝後需要啟動服務:

sudo service fcgiwrap start

如果要在重新開機後會自動啟動 fcgiwrap service,使用下列的指令:

sudo systemctl enable fcgiwrap

在 /etc/nginx 下加入 fcgiwrap.conf,檔案內容如下:

location /cgi-bin/ {
    gzip off;
    root /srv/www;
    fastcgi_pass unix:/var/run/fcgiwrap.sock;
    include /etc/nginx/fastcgi_params;
    fastcgi_param SCRIPT_FILENAME  $document_root$fastcgi_script_name;
}

在想要加入 CGI 支援的 server section 加入下面的設定:

        include fcgiwrap.conf;

重新啟動 Nginx:

sudo systemctl restart nginx

在 /srv/www/cgi-bin/ 撰寫 env.cgi 作為測試。

#!/usr/bin/tclsh
package require ncgi
package require html

::html::init
::ncgi::header

set title "Print Environment"
puts [::html::head $title]
puts [::html::bodyTag]
puts [::html::h1 $title]
puts [::html::tableFromArray env]
puts [::html::end]

需要將 env.cgi 的權限設為可執行。如果沒問題,就可以使用 Nginx 開發或者是執行 CGI 程式。


spawn-fcgi 用來啟動 FastCGI process。 spawn-fcgi 一開始是 Lighttpd 的一部份,不過現在已經獨立出來可以供其他 Web Server 使用。 當使用者撰寫了一個 FastCGI 服務,可以使用 spawn-fcgi 進行管理。

Install spawn-fcgi (@openSUSE):

sudo zypper install spawn-fcgi

接下來的設定是使用 spawn-fcgi 啟動我們撰寫的 FastCGI 服務。
這裡使用 tcl-fcgi (pure Tcl) 測試。 下面就是測試的程式 vclock.tcl,來自 tcl-fcgi 的 example(我將檔案放在 /srv/www/cgi-bin,需要將權限設為可執行):

#! /usr/bin/env tclsh
# vclock.tcl -- originally borrowed from Don Libes' cgi.tcl but rewritten
#


package require ncgi
package require textutil
package require Fcgi
package require Fcgi::helpers

namespace eval vclock {
    namespace path ::fcgi::helpers

    variable EXPECT_HOST    http://expect.sourceforge.net
    variable CGITCL         $EXPECT_HOST/cgi.tcl
    variable TEMPLATE [textutil::undent {
        <!doctype html>
        <html><head><title>Virtual Clock</title></head>
        <body>
        <h1>Virtual Clock - fcgi.tcl style</h1>
        <p>Virtual clock has been accessed <%& $counter %> times since
        startup.</p>
        <hr>
        <p>At the tone, the time will be <strong><%& $time %></strong></p>
        <% if {[dict get $query debug]} { %>
            <pre>     Query: <%& $query %>
            Failed: <%& $failed %></pre>
        <% } %>
        <hr>
        <h2>Set Clock Format</h2>
        <form method="post">
        Show:
        <% foreach name {day month day-of-month year} { %>
          <input type="checkbox" id="<%& $name %>" name="<%& $name %>"
                 <%& [dict get $query $name] ? {checked} : {} %>>
          <label for="<%& $name %>"><%& $name %></label>
        <% } %>
        <br>
        Time style:
        <% foreach value {12-hour 24-hour} { %>
          <input type="radio" id="<%& $value %>" name="type" value="<%& $value %>"
                 <%& [dict get $query type] eq $value ? {checked} : {} %>>
          <label for="<%& $value %>"><%& $value %></label>
        <% } %>
        <br>
        <input type="reset">
        <input type="submit">
        </form>
        <hr>
        See Don Libes' cgi.tcl and original vclock
        at the <a href="<%& $CGITCL %>"><%& $CGITCL %></a>
        </body>
        </html>
    }]
}


proc vclock::main {} {
    variable CGITCL
    variable TEMPLATE

    proc page {query failed counter time CGITCL} [tmpl_parser $TEMPLATE]

    set counter 0

    while {[FCGI_Accept] >= 0} {
        incr counter

        puts -nonewline "Content-Type: text/html\r\n\r\n"

        lassign [validate-params {
            day          boolean                   false
            day-of-month boolean                   false
            debug        boolean                   false
            month        boolean                   false
            type         {regexp ^(?:12|24)-hour$} 24-hour
            year         boolean                   false
        } [query-params {day day-of-month debug month type year}]] query failed

        set format [construct-format $query]
        set time [clock format [clock seconds] -format $format]

        puts [page $query $failed $counter $time $CGITCL]

        ncgi::reset
    } ;# while {[FCGI_Accept] >= 0}
}


proc vclock::construct-format query {
    if {[dict get $query type] eq {}} {
        return {%r %a %h %d '%y}
    }

    set format [expr {
        [dict get $query type] eq {12-hour} ? {%r} : {%T}
    }]

    foreach {name fragment} {
        day { %a}
        month { %h}
        day-of-month { %d}
        year { '%y}
    } {
        if {[dict get $query $name] ne {}} {
            append format $fragment
        }
    }

    return $format
}


# If this is the main script...
if {[info exists argv0] && ([file tail [info script]] eq [file tail $argv0])} {
    vclock::main
}

我們需要撰寫 spawn-fcgi 的 systemd service,在 /usr/lib/systemd/system 目錄下建立 spawnfcgi.service,內容如下:

[Unit]
Description=Spawn FCGI service
After=nss-user-lookup.target

[Service]
Type=forking
Environment=WORKERS=1
ExecStart=/usr/bin/spawn-fcgi \
    -F ${WORKERS} \
    -u nginx \
    -g nginx \
    -s /var/run/%p.sock \
    -P /var/run/%p.pid \
    -- /srv/www/cgi-bin/vclock.tcl
Restart=on-failure
RestartSec=5

[Install]
WantedBy=multi-user.target

在 /etc/nginx 目錄下加入 spawnfcgi.conf,內容如下:

location /vclock/ {
    gzip off;
    fastcgi_pass unix:/var/run/spawnfcgi.sock;
    include /etc/nginx/fastcgi_params;
}

在想要加入 spawn-fcgi 支援的 server section 加入下面的設定:

        include spawnfcgi.conf;

啟動 spawn-fcgi:

sudo systemctl start spawnfcgi

重新啟動 Nginx:

sudo systemctl restart nginx

使用瀏覽器瀏覽 http://localhost/vclock/,檢查結果是否正確。

2023-10-08

Change the Screen Resolution (Linux)

Linux 上可以使用 command line tool xrandr 來設定 screen resolution。

我之所以會有這個需要,是因為在使用 Wine 玩某些舊遊戲的時候,有些舊遊戲在結束以後並不會正確的將螢幕解析度設回來。所以寫了一個小程式可以使用 xrandr 快速的設定回來。目前我這台電腦設定值是 1366x768,所以小程式的預設值我也是這樣設。

#!/usr/bin/tclsh

if {$argc >= 1} {
    set mysize [lindex $argv 0]
} elseif {$argc == 0} {
    set mysize 1366x768
}

set var [list xrandr -s $mysize]
exec {*}$var

2023-09-15

NaviServer 4.99.28

Announcement: NaviServer 4.99.28 available
This release is a pure bug-fix and maintenance release, which fixes a bug annoying for some OpenACS users.

 

詳細的修改內容可以參考發佈的公告。

2023-07-06

tksvg 0.13 released

tksvg 0.13 released


看起來是因為 nanosvg 更新,所以 tksvg 跟著更新了,更多的資訊可以參考上面的連結。

2023-07-04

tablelist 6.22

tablelist


tablelist 釋出了 6.22 版。另外,tablelist 也是 Tklib 的套件,所以 Tklib 內的相關套件部份看起來也更新了。

2023-06-01

tclx 8.6.2

tclx


tclx 做了一些小改進 (filter rresvport if not present),版本則更新為 8.6.2。之前的 8.6.1 則有加強了對於 Clang 16  的相容性 (Fix configure.ac compatibility with Clang 16)。

2023-05-13

NaviServer 4.99.25 available

 NaviServer 釋出了 4.99.25 版,詳細的資料可以參考 Announcement: NaviServer 4.99.25 available 這篇公告。

2023-03-24

tcl-rocksdb 0.3.2

tcl-rocksdb

 

openSUSE build service 上現在有一個官方維護的 rocksdb,今天收到刪掉我自己維護版本的要求,我想了一下,我也有一段時間沒有更新了,所以刪掉了我自己維護的版本,換成官方的。然後發現 rocksdb 8.0.0 函式庫已經需要 c++ 17 才能夠編譯,所以修改了 tcl-rocksdb 的編譯選項,這樣才能夠成功編譯。

更新:
OBS 下的 server:database/rocksdb 一個很不妙的點是,他們還是把 jemalloc  OPTION 設為 ON,然後系統的 jemalloc 並沒有針對 jemalloc 5.0.1 TLS error: cannot allocate memory in static TLS block 做出相關的改變,這樣會變成可以編譯成功,但是你在使用的時候會無法啟動。

一開始我只是想建個 link 在自己  repo 這樣可以避免找不到 rocksdb 的問題,但是我發現問題很大,所以我有 report 我自己的修改,同時也有提供資訊,至於要怎麼改是打包的人要決定的。總之解法不是直接關閉 jremalloc 選項,效能會下降但是可以執行;不然就是系統端提供的 jemalloc 要加 --disable-initial-exec-tls 並且重新編譯,然後因為 jemalloc 的問題解決了就可以編譯 rocksdb with jemalloc。

2023-01-24

BAWT 2.3.1

Announce: BAWT 2.3.1 released

 

The following features are included in this release:
- Switched default MinGW gcc version back to 7.2.0. Version 8.1.0 produced incorrect tcltls binaries.
- Corrected download URL to https://www.tcl3d.org/bawt/download due to new server configuration using https.
- New package: Snack.
- Updated packages: CAWT, mupdf, MuPDFWidget, rl_json, SWIG.

所以 BATW 因為 MinGW gcc 的關係,更新了一個小版本。