ew8bak/ewsdr
1
0
Fork 0
mirror of https://git.vladimir.cc/vladimir/ewsdr.git synced 2026-08-25 18:43:51 +00:00
Code Issues Packages Projects Releases Wiki Activity

fix(tci): писатель WAV — один поток с очередью, файл публикуется атомарно

Browse Source 
SAVE запускал поток на каждую запись с FreeOnTerminate: его никто не держал
и никто не ждал. Замерено отдельным процессом — при штатном выходе сразу
после сохранения от ожидаемых 100000044 байт на диске оставалось 40960, а
заголовок заявлял полную длину; на медленном каталоге идущие подряд SAVE
плодили сотни потоков, чья память стеков в 128-МБ бюджет не входила.

Теперь писатель один и принадлежит адаптеру (лениво на первом SAVE), очередь
ограничена TCI_RECORD_MAX_JOBS = 16 (сверх — клиенту writer busy и возврат
резерва), а деструктор адаптера гасит его через TCIStopWriter: Close →
WaitDrained (без срока) → Free. Срока здесь нет намеренно: поток, стоящий в
write/fsync, изнутри процесса не останавливается (Terminate не указ, Free
обязан WaitFor, бросить живой TThread нельзя — он ходит в общий бюджет),
поэтому срок не ограничивал выход, а только терял подтверждённые клиенту
записи. Ограниченный выход = писатель отдельным процессом, одним TThread не
делается; это записано в коде и в доке.

Результат записи больше не игнорируется: FileWrite возвращает число байт и
при ошибке даёт 0/-1 без исключения, поэтому на полном диске файл спокойно
дописывался до конца огрызком. TCIWriteAll — цикл с проверкой каждого вызова,
плюс FileFlush перед публикацией (на ext4 с отложенным размещением ENOSPC
приходит именно там).

Файл появляется под целевым именем целиком или не появляется вовсе: данные
пишутся во временный файл рядом (эксклюзивно, не по симлинку), а публикует
их TCIPublishFile — renameat2(RENAME_NOREPLACE) напрямую через Do_SysCall,
если его нет — link + unlink, если нет и ссылок (FAT/exFAT, часть CIFS/SMB и
FUSE) — отказ с сохранением данных в .part. FileExists + rename не делается
нигде: это тот самый TOCTOU. На Windows — MoveFileW без REPLACE_EXISTING.

doc/TCI.md: §2.5 переписан (писатель-очередь, остановка, публикация); заодно
исправлено устаревшее описание склейки кусков в Take (её нет с 7aae0fd).

Стенд test/tci: 214 проверок (было 199), все зелёные. Новое — временный файл
убирается после удачи, неудачная запись не оставляет ни файла, ни .part, за
всё время записи 32 МБ целевое имя ни разу не видно незаконченным, отказ
сверх потолка заданий, после Close заданий не берут, TCIStopWriter дожидается
и самой записи, и хвоста очереди за ней. Все новые гарантии прогнаны
негативным контролем; путь link проверен сборкой с выключенным renameat2,
сам renameat2 — под strace.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
ew8bak
2026-08-19 19:40:31 +03:00
co-authored by Claude Opus 5
parent 7aae0fdfcd
commit 3dc7035f9e
4 changed files with 734 additions and 134 deletions
Download Patch File Download Diff File Expand all files Collapse all files
TCIStreams.pas
+410 -75
View File
@@ -37,6 +37,8 @@ uses
// ловилось в DX-кластере. Порядок здесь и есть лечение.
{$IFDEF WINDOWS}Windows,{$ENDIF}
{$IFDEF UNIX}BaseUnix,{$ENDIF}
// renameat2 обёртки в RTL нет, а нужен именно он (см. TCIPublishFile).
{$IFDEF LINUX}syscall,{$ENDIF}
Classes, SysUtils, Math, SyncObjs, TCIProtocol, TCIServer;
const
@@ -48,6 +50,12 @@ const
// заведены под него в конструкторе: SetLength в DSP-потоке на каждый блок
// аудио — это тысячи обращений к куче в секунду на ровном месте.
TCI_FEED_CHUNK = 4096;
// ★Очередь писателя WAV. Заданий больше этого числа не копим: клиент
// услышит отказ, а не будет молча наполнять память сохранениями, которые
// медленный диск разгребёт неизвестно когда. Каждое задание держит своё
// место в общем бюджете (TCI_RECORD_MAX_BYTES), так что памятью очередь
// ограничена и без счётчика — этот потолок про сами задания.
TCI_RECORD_MAX_JOBS = 16;
type
{ Накопленная запись: 16-битный PCM с чередованием L/R. }
@@ -206,8 +214,9 @@ type
молчащий, мёртвый или замьюченный приёмник не занимает ничего, а растущая
запись спрашивает разрешения на каждый кусок у общего бюджета
TCI_RECORD_MAX_BYTES. Куски не перевыделяются (никакого realloc в
DSP-потоке) и склеиваются один раз, в Take — а он идёт уже после того, как
рекордер вынут из таблицы, то есть без DSP-потока на плечах. }
DSP-потоке) и НЕ склеиваются вовсе: Take отдаёт их писателю как есть, а тот
пишет их в файл подряд — сплошная копия удваивала бы пик памяти ровно
там, где её меньше всего. }
TTCIRecorder = class
private
FLock: TCriticalSection;
@@ -243,23 +252,63 @@ type
property Owner: TObject read FOwner;
end;
{ Писатель WAV в своём потоке: файл до 60 МБ, а зовут сохранение из тика
сервера — блокировать его на секунду диска нельзя. Данные забирает себе
КУСКАМИ, вместе с их местом в общем бюджете (TTCIRecTake.Reserved), и
отпускает его, только когда они больше не нужны. Пока писатель ждёт
медленный диск, эти байты остаются занятыми — так потолок и держит
очередь сохранений, а не только сами записи. }
{ Одно задание писателю: куда писать и что. }
TTCIRecJob = record
Path: string;
Rec: TTCIRecTake;
Rate: Integer;
end;
{ Писатель WAV: ОДИН поток с очередью, которым владеет адаптер. Пишет не
вызывающий (файл до 60 МБ, а зовут сохранение из потока клиента), но и не
кто попало.
★Раньше на каждый SAVE заводился отдельный поток с FreeOnTerminate: его
никто не держал и никто не ждал. Отсюда две беды.
(1) Штатный выход из программы обрывал запись на полуслове — замерено: из
ожидаемых 100000044 байт на диске оставалось 40960 (то, что успел
сбросить буфер ФС), а заголовок при этом заявлял полную длину.
(2) На медленном или зависшем каталоге идущие подряд SAVE плодили сотни
потоков, и память их стеков в 128-МБ бюджет не входила вовсе.
Теперь очередь ограничена (TCI_RECORD_MAX_JOBS — дальше клиент слышит
отказ), поток один, а адаптер при своей гибели дожидается ВСЕЙ очереди и
делает WaitFor (TCIStopWriter) — ни брошенных потоков, ни выброшенных
записей после нас не остаётся. Данные каждого задания держат своё место в
общем бюджете (TTCIRecTake.Reserved) до конца записи — так потолок держит
и очередь сохранений, а не только сами записи. }
TTCIWavWriter = class(TThread)
private
FPath: string;
FRec: TTCIRecTake;
FRate: Integer;
procedure ReleaseData;
FLock: TCriticalSection;
FWake: PRTLEvent;
FJobs: array of TTCIRecJob; // очередь, FIFO
FBusy: Boolean; // задание на руках у Execute
FClosed: Boolean; // идёт остановка: новых не принимаем
function Pop(out J: TTCIRecJob): Boolean;
procedure Done;
procedure WriteJob(const J: TTCIRecJob);
class procedure ReleaseJob(var J: TTCIRecJob);
protected
procedure Execute; override;
public
constructor Create(const APath: string; const ARec: TTCIRecTake;
ARateHz: Integer);
constructor Create;
destructor Destroy; override;
{ Поставить запись в очередь. False — очередь полна или писатель гасится;
тогда куски и их место в бюджете остаются на вызывающем (он обязан
вернуть Reserved сам). }
function Enqueue(const APath: string; const ARec: TTCIRecTake;
ARateHz: Integer): Boolean;
{ Сколько заданий ещё не дописано (вместе с тем, что пишется сейчас). }
function Pending: Integer;
{ Больше не принимать заданий (первый шаг остановки). }
procedure Close;
{ Ждать, пока очередь опустеет — БЕЗ СРОКА. Всякий срок здесь оказался
обманом: остановить поток, стоящий в write/fsync, изнутри процесса всё
равно нечем (Terminate ему не указ, а Free обязан сделать WaitFor),
поэтому срок не спасал от зависания — он только терял хвост очереди на
медленном каталоге, который потом оживал. За каждую запись в очереди
клиенту уже сказано «сохранено», так что ждём столько, сколько нужно. }
procedure WaitDrained;
end;
{ Коэффициент прореживания SrcRate → WantRate: наибольший целый делитель,
@@ -304,6 +353,13 @@ function TCIRecordPath(const BaseDir, Req: string): string;
имя приходит из сети. THandle(-1) — не вышло. }
function TCICreateNewFile(const Path: string): THandle;
{ Погасить писателя: закрыть приём заданий, дождаться ВСЕЙ очереди и
освободить объект (Destroy = Terminate + WaitFor). Зовут при гибели
адаптера, ради этого писатель и стал управляемым. W обнуляется в любом
случае.
★Срока здесь нет намеренно — см. WaitDrained и комментарий в реализации. }
procedure TCIStopWriter(var W: TTCIWavWriter);
implementation
{ ═══════════════════════════════════════════════════════════════════════════
@@ -903,38 +959,282 @@ end;
WAV
═══════════════════════════════════════════════════════════════════════════ }
constructor TTCIWavWriter.Create(const APath: string;
const ARec: TTCIRecTake; ARateHz: Integer);
{ ─── вспомогательное для записи файла ──────────────────────────────────── }
var
RecTmpSeq: LongInt = 0;
function TCIRecTempName(const Path: string): string;
// Имя временного файла. Уникальное: застрявший от прошлого падения «.part» не
// должен запирать сохранение под тем же именем навсегда.
begin
Result := Format('%s.%d-%d.part',
[Path, Integer(GetProcessID), InterLockedIncrement(RecTmpSeq)]);
end;
function TCIWriteAll(H: THandle; const Buf; Count: Integer): Boolean;
// ★Результат записи проверяем, и не «= Count», а циклом. FileWrite (как и
// THandleStream.Write под ним) возвращает ЧИСЛО записанных байт и при ошибке
// отдаёт 0 или -1, не поднимая исключения: на полном диске прежний код
// спокойно дописывал WAV до конца, оставляя огрызок с заголовком на полную
// длину. Короткая запись без ошибки тоже законна (сигнал, лимит ФС) — её
// дописываем, а не считаем провалом.
var
P: PByte;
n: Integer;
begin
P := @Buf;
while Count > 0 do
begin
n := FileWrite(H, P^, Count);
if n <= 0 then Exit(False);
Inc(P, n);
Dec(Count, n);
end;
Result := True;
end;
{ Чем кончилась публикация: легло под целевым именем / имя занято /
публиковать нечем — на этой ФС нет ни одной безопасной операции. }
type
TTCIPubResult = (tpubDone, tpubTaken, tpubNoWay);
{$IF DEFINED(LINUX) and (DEFINED(CPUX86_64) or DEFINED(CPUI386) or
DEFINED(CPUAARCH64) or DEFINED(CPUARM))}
{$DEFINE TCI_HAS_RENAMEAT2}
{$IFEND}
{$IFDEF TCI_HAS_RENAMEAT2}
const
// Обёртки в RTL нет, зовём напрямую. Номера — стабильная часть ABI ядра.
{$IFDEF CPUX86_64} TCI_SYS_RENAMEAT2 = 316; {$ENDIF}
{$IFDEF CPUI386} TCI_SYS_RENAMEAT2 = 353; {$ENDIF}
{$IFDEF CPUAARCH64} TCI_SYS_RENAMEAT2 = 276; {$ENDIF}
{$IFDEF CPUARM} TCI_SYS_RENAMEAT2 = 382; {$ENDIF}
TCI_AT_FDCWD = -100;
TCI_RENAME_NOREPLACE = 1;
{$ENDIF}
{$IFDEF UNIX}
function TCIRenameNoReplace(const Src, Dst: string; out Err: Integer): Boolean;
// «Переименовать, если имя свободно» — одним вызовом ядра. Нет такого вызова
// (старое ядро, другая архитектура, ФС не умеет флаг) — Err = ENOSYS/EINVAL, и
// вызывающий идёт дальше по списку.
begin
Result := False;
Err := ESysENOSYS;
{$IFDEF TCI_HAS_RENAMEAT2}
if Do_SysCall(TSysParam(TCI_SYS_RENAMEAT2),
TSysParam(TCI_AT_FDCWD), TSysParam(PtrUInt(PChar(Src))),
TSysParam(TCI_AT_FDCWD), TSysParam(PtrUInt(PChar(Dst))),
TSysParam(TCI_RENAME_NOREPLACE)) = 0 then
Exit(True);
Err := fpGetErrno;
{$ENDIF}
end;
{$ENDIF}
function TCIPublishFile(const Src, Dst: string): TTCIPubResult;
// ★Публикация готового файла: целевое имя появляется ОДНИМ вызовом ядра, сразу
// с полным содержимым, и только если оно свободно. Замены нет ни в каком виде.
//
// Портируемо получить сразу три свойства — атомарное появление, запрет замены
// и работу на любой ФС — нельзя, поэтому идём по списку и на последнем шаге
// честно отказываемся:
// 1) renameat2(RENAME_NOREPLACE) — то, что нужно, одним вызовом;
// 2) нет его — link(2) + unlink: новое имя обязано не существовать (EEXIST),
// на симлинк по этому имени link тоже не пойдёт. Каталог у Src и Dst один
// (записи лежат в tci.record_dir), так что EXDEV тут не бывает;
// 3) нет и жёстких ссылок (FAT/exFAT, часть CIFS/SMB и FUSE) — публиковать
// нечем. ★FileExists + rename здесь НЕ годится: rename затирает то, что
// лежит по имени сейчас, а между проверкой и переносом туда может попасть
// что угодно — это ровно то окно (TOCTOU), ради закрытия которого всё и
// затевалось. Отвечаем tpubNoWay; данные при этом не пропадают — писатель
// оставляет их во временном файле (см. WriteJob).
// На Windows MoveFileW без MOVEFILE_REPLACE_EXISTING уже обладает нужной
// семантикой: существующее имя = отказ.
{$IFDEF UNIX}
var Err: Integer;
{$ENDIF}
begin
{$IFDEF UNIX}
if TCIRenameNoReplace(Src, Dst, Err) then Exit(tpubDone);
if Err = ESysEEXIST then Exit(tpubTaken);
if FpLink(PChar(Src), PChar(Dst)) = 0 then
begin
// Временное имя убираем: данные уже живут под целевым (это тот же inode).
FpUnlink(PChar(Src));
Exit(tpubDone);
end;
if fpGetErrno = ESysEEXIST then Exit(tpubTaken);
Result := tpubNoWay;
{$ELSE}
// WINBOOL — не Boolean: сравнение делает приведение явным.
if MoveFileW(PWideChar(UnicodeString(Src)),
PWideChar(UnicodeString(Dst))) <> False then
Exit(tpubDone);
if (GetLastError = ERROR_ALREADY_EXISTS) or
(GetLastError = ERROR_FILE_EXISTS) then
Exit(tpubTaken);
Result := tpubNoWay;
{$ENDIF}
end;
{ ─── писатель ─────────────────────────────────────────────────────────── }
constructor TTCIWavWriter.Create;
begin
inherited Create(True);
FreeOnTerminate := True;
FPath := APath;
FRec := ARec;
FRate := ARateHz;
FLock := TCriticalSection.Create;
FWake := RTLEventCreate;
Start;
end;
procedure TTCIWavWriter.ReleaseData;
destructor TTCIWavWriter.Destroy;
var J: TTCIRecJob;
begin
Terminate;
RTLEventSetEvent(FWake);
WaitFor;
// Недописанное (гасят, не дождавшись очереди) — данные всё равно вернуть в
// бюджет: объект умирает, а счётчик общий и переживёт нас.
while Pop(J) do ReleaseJob(J);
Done;
RTLEventDestroy(FWake);
FLock.Free;
inherited;
end;
class procedure TTCIWavWriter.ReleaseJob(var J: TTCIRecJob);
// Данные и их место в бюджете уходят вместе и ровно один раз — сколько бы
// путей выхода ни было у Execute.
// путей выхода ни было у записи.
var i: Integer;
begin
for i := 0 to High(FRec.Chunks) do FRec.Chunks[i] := nil;
FRec.Chunks := nil;
TCIRecBudgetFree(FRec.Reserved);
FRec.Reserved := 0;
for i := 0 to High(J.Rec.Chunks) do J.Rec.Chunks[i] := nil;
J.Rec.Chunks := nil;
TCIRecBudgetFree(J.Rec.Reserved);
J.Rec.Reserved := 0;
J.Rec.Count := 0;
end;
function TTCIWavWriter.Enqueue(const APath: string; const ARec: TTCIRecTake;
ARateHz: Integer): Boolean;
var n: Integer;
begin
Result := False;
FLock.Enter;
try
if FClosed or Terminated then Exit;
n := Length(FJobs);
if n >= TCI_RECORD_MAX_JOBS then Exit;
SetLength(FJobs, n + 1);
FJobs[n].Path := APath;
FJobs[n].Rec := ARec;
FJobs[n].Rate := ARateHz;
Result := True;
finally
FLock.Leave;
end;
RTLEventSetEvent(FWake);
end;
function TTCIWavWriter.Pop(out J: TTCIRecJob): Boolean;
var i: Integer;
begin
Result := False;
FillChar(J.Rec, SizeOf(J.Rec), 0);
J.Path := '';
J.Rate := 0;
FLock.Enter;
try
if Length(FJobs) = 0 then Exit;
J := FJobs[0];
for i := 1 to High(FJobs) do FJobs[i - 1] := FJobs[i];
FJobs[High(FJobs)].Path := ''; // строку из хвоста отпускаем
FJobs[High(FJobs)].Rec.Chunks := nil;
SetLength(FJobs, Length(FJobs) - 1);
FBusy := True;
Result := True;
finally
FLock.Leave;
end;
end;
procedure TTCIWavWriter.Done;
begin
FLock.Enter;
try
FBusy := False;
finally
FLock.Leave;
end;
end;
function TTCIWavWriter.Pending: Integer;
begin
FLock.Enter;
try
Result := Length(FJobs);
if FBusy then Inc(Result);
finally
FLock.Leave;
end;
end;
procedure TTCIWavWriter.Close;
begin
FLock.Enter;
try
FClosed := True;
finally
FLock.Leave;
end;
end;
procedure TTCIWavWriter.WaitDrained;
begin
while Pending <> 0 do Sleep(5);
end;
procedure TTCIWavWriter.Execute;
var J: TTCIRecJob;
begin
while True do
begin
if Pop(J) then
begin
try
// ★Взятое из очереди пишем ВСЕГДА, даже если уже идёт остановка: за
// каждое задание клиенту сказано «сохранено», и молча выбросить его
// нельзя. Остановка до этого места и не доходит — TCIStopWriter
// сперва дожидается пустой очереди.
WriteJob(J);
except
// Исключение из потока утащило бы за собой процесс. Сказать о беде
// всё равно некому: SAVE давно подтверждён клиенту.
end;
ReleaseJob(J);
Done;
Continue;
end;
if Terminated then Break;
// Таймаут, а не голое ожидание: Terminate между Pop и сюда не потеряется.
RTLEventWaitFor(FWake, 200);
end;
end;
procedure TTCIWavWriter.WriteJob(const J: TTCIRecJob);
// Заголовок собираем в буфере: WAV — это фиксированные 44 байта, и городить
// два десятка отдельных Write ради них незачем (а строковые литералы в
// нетипизированный Write в FPC ещё и передаются не тем, чем кажется).
// два десятка отдельных записей ради них незачем (а строковые литералы в
// нетипизированный Write в FPC ещё и передаются не тем, чем кажутся).
var
FS: THandleStream;
H: THandle;
HT: THandle;
Tmp: string;
Hdr: array[0..43] of Byte;
DataBytes: LongWord;
i, n, Left: Integer;
Ok: Boolean;
Pub: TTCIPubResult;
procedure PutTag(Ofs: Integer; const Tag: string);
var i: Integer;
@@ -954,57 +1254,92 @@ var
end;
begin
try
DataBytes := LongWord(Int64(FRec.Count) * 2 * SizeOf(SmallInt));
FillChar(Hdr, SizeOf(Hdr), 0);
PutTag(0, 'RIFF');
PutU32(4, 36 + DataBytes);
PutTag(8, 'WAVE');
PutTag(12, 'fmt ');
PutU32(16, 16); // размер fmt-блока
PutU16(20, 1); // PCM
PutU16(22, 2); // каналов
PutU32(24, LongWord(FRate));
PutU32(28, LongWord(FRate) * 2 * 2); // байт в секунду
PutU16(32, 4); // выравнивание блока
PutU16(34, 16); // бит на сэмпл
PutTag(36, 'data');
PutU32(40, DataBytes);
DataBytes := LongWord(Int64(J.Rec.Count) * 2 * SizeOf(SmallInt));
FillChar(Hdr, SizeOf(Hdr), 0);
PutTag(0, 'RIFF');
PutU32(4, 36 + DataBytes);
PutTag(8, 'WAVE');
PutTag(12, 'fmt ');
PutU32(16, 16); // размер fmt-блока
PutU16(20, 1); // PCM
PutU16(22, 2); // каналов
PutU32(24, LongWord(J.Rate));
PutU32(28, LongWord(J.Rate) * 2 * 2); // байт в секунду
PutU16(32, 4); // выравнивание блока
PutU16(34, 16); // бит на сэмпл
PutTag(36, 'data');
PutU32(40, DataBytes);
// ★Не TFileStream/fmCreate: имя пришло из сети, и затирать им чужой файл
// нельзя. TCICreateNewFile создаёт только новый и не идёт по симлинку.
H := TCICreateNewFile(FPath);
// Не вышло (файл уже есть, нет прав, нет каталога) — просто уходим: выйти
// отсюда через Exit нельзя, ниже ещё возврат памяти под данные.
if H <> THandle(-1) then
begin
FS := THandleStream.Create(H);
try
FS.Write(Hdr[0], SizeOf(Hdr));
// Куски пишем подряд: в WAV сэмплы и так лежат встык, а хвост
// последнего куска за FRec.Count — не наши данные.
Left := FRec.Count;
for i := 0 to High(FRec.Chunks) do
begin
if Left <= 0 then Break;
n := FRec.Chunk;
if n > Left then n := Left;
FS.Write(FRec.Chunks[i][0], n * 2 * SizeOf(SmallInt));
Dec(Left, n);
end;
finally
FS.Free;
FileClose(H);
// ★Целевого имени до конца записи не существует ВООБЩЕ. Пишем во временный
// файл рядом (эксклюзивно и не по симлинку — имя пришло из сети), и только
// когда всё сошлось, публикуем его под целевым именем одним вызовом ядра.
// Так клиент, увидевший файл, всегда прав: раньше по имени сначала
// появлялась пустышка на 0 байт, и на медленном диске её было видно всю
// запись, а до того — огрызок с заголовком на полную длину.
Ok := False;
Tmp := TCIRecTempName(J.Path);
HT := TCICreateNewFile(Tmp);
if HT <> THandle(-1) then
begin
try
Ok := TCIWriteAll(HT, Hdr, SizeOf(Hdr));
Left := J.Rec.Count;
i := 0;
// Куски пишем подряд: в WAV сэмплы и так лежат встык, а хвост
// последнего куска за Count — не наши данные.
while Ok and (Left > 0) and (i <= High(J.Rec.Chunks)) do
begin
n := J.Rec.Chunk;
if n > Left then n := Left;
Ok := TCIWriteAll(HT, J.Rec.Chunks[i][0], n * 2 * SizeOf(SmallInt));
Dec(Left, n);
Inc(i);
end;
// Данных меньше, чем обещано заголовком, — это тот же огрызок.
if Left > 0 then Ok := False;
// ★Сброс на диск ДО переименования: на ext4 с отложенным размещением
// «нет места» приходит не в write, а вот здесь.
if Ok then Ok := FileFlush(HT);
finally
FileClose(HT);
end;
except
// Записать не вышло (нет прав, нет каталога, диск полон) — сказать об этом
// клиенту уже некому: команда давно подтверждена. Молчим, но и не падаем:
// исключение из потока утащило бы за собой процесс.
// Публикуем только целое.
Pub := tpubTaken;
if Ok then Pub := TCIPublishFile(Tmp, J.Path);
// Не дописали или имя занято — ни огрызка, ни временного файла.
// ★А вот tpubNoWay (на этой ФС публиковать нечем) временный файл ОСТАВЛЯЕТ:
// сказать клиенту уже нечем (SAVE подтверждён давно), и молча стереть его
// десятки мегабайт из-за нашей неспособности переименовать — хуже, чем
// оставить их под именем «<файл>.<pid>-<n>.part».
if (not Ok) or (Pub = tpubTaken) then DeleteFile(Tmp);
end;
ReleaseData;
end;
procedure TCIStopWriter(var W: TTCIWavWriter);
var Left: TTCIWavWriter;
begin
Left := W;
W := nil;
if Left = nil then Exit;
Left.Close; // очередь больше не растёт
Left.WaitDrained; // дожидаемся ВСЕЙ очереди
Left.Free; // Terminate + wake + WaitFor уже пустого потока
end;
{ ★Почему здесь нет никакого срока — история двух неверных попыток.
Внутрипроцессный поток, стоящий в write(2) или fsync, остановить нечем:
Terminate ему не указ, а Free обязан сделать WaitFor (бросить живой TThread
нельзя — он ходит в общий бюджет, RecBudgetLock, который финализация юнита
освобождает). Значит, срок НЕ ограничивает выход: на мёртвом каталоге
программа всё равно ждёт syscall. Ограничивал он ровно одно — сколько записей
мы выбросим по дороге: сперва весь остаток очереди по общему сроку, потом (с
отсчётом от последнего продвижения) остаток очереди на каталоге, который
тормозил дольше срока и оживал. То есть срок не покупал ничего и стоил
подтверждённых клиенту записей. Убран.
Кому действительно нужен ограниченный выход — писателя придётся выносить в
отдельный процесс, который гасится средствами ОС; одним TThread это не
делается. }
{ ═══════════════════════════════════════════════════════════════════════════
Утилиты
═══════════════════════════════════════════════════════════════════════════ }